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
 503 // dynamic memory handles
 504 typedef struct UHandleInfo_t {
 505   uint32_t ufoHandle;
 506   uint32_t typeid;
 507   uint8_t *data;
 508   uint32_t size;
 509   uint32_t used;
 510   // in free list
 511   struct UHandleInfo_t *next;
 512 } UfoHandle;
 513
 514 static UfoHandle *ufoHandleFreeList = NULL;
 515 static UfoHandle **ufoHandles = NULL;
 516 static uint32_t ufoHandlesUsed = 0;
 517 static uint32_t ufoHandlesAlloted = 0;
 518
 519 #define UFO_HANDLE_FREE  (~(uint32_t)0)
 520
 521 static char ufoCurrFileLine[520];
 522
 523 // for `ufoFatal()`
 524 static uint32_t ufoInBacktrace = 0;
 525
 526
 527 // ////////////////////////////////////////////////////////////////////////// //
 528 static void ufoClearCondDefines (void);
 529
 530 static void ufoRunVMCFA (uint32_t cfa);
 531
 532 static void ufoBacktrace (uint32_t ip, int showDataStack);
 533
 534 static void ufoClearCondDefines (void);
 535
 536 static UfoState *ufoNewState (void);
 537 static void ufoInitStateUserVars (UfoState *st, uint32_t cfa);
 538 static void ufoFreeState (UfoState *st);
 539 static UfoState *ufoFindState (uint32_t stid);
 540 static void ufoSwitchToState (UfoState *newst);
 541
 542 __attribute__((unused)) static void ufoDumpWordHeader (const uint32_t lfa);
 543
 544 #ifndef WIN32
 545 static void ufoDisableRaw (void);
 546 static void ufoTTYRawFlush (void);
 547 #endif
 548 static int ufoIsGoodTTY (void);
 549
 550 #ifdef UFO_DEBUG_DEBUG
 551 static void ufoDumpDebugImage (void);
 552 #endif
 553
 554
 555 // ////////////////////////////////////////////////////////////////////////// //
 556 #define UFWORD(name_) \
 557 static void ufoWord_##name_ (uint32_t mypfa)
 558
 559 #define UFCALL(name_)  ufoWord_##name_(0)
 560 #define UFCFA(name_)   (&ufoWord_##name_)
 561
 562 // for TIB words
 563 UFWORD(CPEEK_REGA_IDX);
 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   #ifndef WIN32
 582   ufoTTYRawFlush();
 583   #endif
 584   fflush(NULL);
 585 }
 586
 587
 588 //==========================================================================
 589 //
 590 //  ufoSetInFileName
 591 //
 592 //  if `reuse` is not 0, reuse/free `fname`
 593 //
 594 //==========================================================================
 595 static void ufoSetInFileNameEx (const char *fname, int reuse) {
 596   ufo_assert(fname == NULL || (fname != ufoInFileName));
 597   if (fname == NULL || fname[0] == 0) {
 598     if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
 599     ufoInFileNameLen = 0;
 600     ufoInFileNameHash = 0;
 601     if (reuse && fname != NULL) free((void *)fname);
 602   } else {
 603     const uint32_t fnlen = (uint32_t)strlen(fname);
 604     const uint32_t fnhash = joaatHashBuf(fname, fnlen, 0);
 605     if (ufoInFileNameLen != fnlen || ufoInFileNameHash != fnhash) {
 606       if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
 607       if (reuse) {
 608         ufoInFileName = (char *)fname;
 609       } else {
 610         ufoInFileName = strdup(fname);
 611         if (ufoInFileName == NULL) ufoFatal("out of memory for filename info");
 612       }
 613       ufoInFileNameLen = fnlen;
 614       ufoInFileNameHash = fnhash;
 615     } else {
 616       if (reuse && fname != NULL) free((void *)fname);
 617     }
 618   }
 619 }
 620
 621
 622 //==========================================================================
 623 //
 624 //  ufoSetInFileName
 625 //
 626 //==========================================================================
 627 UFO_FORCE_INLINE void ufoSetInFileName (const char *fname) {
 628   ufoSetInFileNameEx(fname, 0);
 629 }
 630
 631
 632 //==========================================================================
 633 //
 634 //  ufoSetInFileNameReuse
 635 //
 636 //==========================================================================
 637 UFO_FORCE_INLINE void ufoSetInFileNameReuse (const char *fname) {
 638   ufoSetInFileNameEx(fname, 1);
 639 }
 640
 641
 642 //==========================================================================
 643 //
 644 //  ufoSetUserAbort
 645 //
 646 //==========================================================================
 647 void ufoSetUserAbort (void) {
 648   ufoVMAbort = 1;
 649 }
 650
 651
 652 //==========================================================================
 653 //
 654 //  ufoAllocHandle
 655 //
 656 //==========================================================================
 657 static UfoHandle *ufoAllocHandle (uint32_t typeid) {
 658   ufo_assert(typeid != UFO_HANDLE_FREE);
 659   UfoHandle *newh = ufoHandleFreeList;
 660   if (newh == NULL) {
 661     if (ufoHandlesUsed == ufoHandlesAlloted) {
 662       uint32_t newsz = ufoHandlesAlloted + 16384;
 663       // due to offsets, this is the maximum number of handles we can have
 664       if (newsz > 0x1ffffU) {
 665         if (ufoHandlesAlloted > 0x1ffffU) ufoFatal("too many dynamic handles");
 666         newsz = 0x1ffffU + 1U;
 667         ufo_assert(newsz > ufoHandlesAlloted);
 668       }
 669       UfoHandle **nh = realloc(ufoHandles, sizeof(ufoHandles[0]) * newsz);
 670       if (nh == NULL) ufoFatal("out of memory for handle table");
 671       ufoHandles = nh;
 672       ufoHandlesAlloted = newsz;
 673     }
 674     newh = calloc(1, sizeof(UfoHandle));
 675     if (newh == NULL) ufoFatal("out of memory for handle info");
 676     ufoHandles[ufoHandlesUsed] = newh;
 677     // setup new handle info
 678     newh->ufoHandle = (ufoHandlesUsed << UFO_ADDR_HANDLE_SHIFT) | UFO_ADDR_HANDLE_BIT;
 679     ufoHandlesUsed += 1;
 680   } else {
 681     ufo_assert(newh->typeid == UFO_HANDLE_FREE);
 682     ufoHandleFreeList = newh->next;
 683   }
 684   // setup new handle info
 685   newh->typeid = typeid;
 686   newh->data = NULL;
 687   newh->size = 0;
 688   newh->used = 0;
 689   newh->next = NULL;
 690   return newh;
 691 }
 692
 693
 694 //==========================================================================
 695 //
 696 //  ufoFreeHandle
 697 //
 698 //==========================================================================
 699 static void ufoFreeHandle (UfoHandle *hh) {
 700   if (hh != NULL) {
 701     ufo_assert(hh->typeid != UFO_HANDLE_FREE);
 702     if (hh->data) free(hh->data);
 703     hh->typeid = UFO_HANDLE_FREE;
 704     hh->data = NULL;
 705     hh->size = 0;
 706     hh->used = 0;
 707     hh->next = ufoHandleFreeList;
 708     ufoHandleFreeList = hh;
 709   }
 710 }
 711
 712
 713 //==========================================================================
 714 //
 715 //  ufoGetHandle
 716 //
 717 //==========================================================================
 718 static UfoHandle *ufoGetHandle (uint32_t hh) {
 719   UfoHandle *res;
 720   if (hh != 0 && (hh & UFO_ADDR_HANDLE_BIT) != 0) {
 721     hh = (hh & UFO_ADDR_HANDLE_MASK) >> UFO_ADDR_HANDLE_SHIFT;
 722     if (hh < ufoHandlesUsed) {
 723       res = ufoHandles[hh];
 724       if (res->typeid == UFO_HANDLE_FREE) res = NULL;
 725     } else {
 726       res = NULL;
 727     }
 728   } else {
 729     res = NULL;
 730   }
 731   return res;
 732 }
 733
 734
 735 //==========================================================================
 736 //
 737 //  setLastIncPath
 738 //
 739 //==========================================================================
 740 static void setLastIncPath (const char *fname, int system) {
 741   if (fname == NULL || fname[0] == 0) {
 742     if (system) {
 743       if (ufoLastSysIncPath) free(ufoLastIncPath);
 744       ufoLastSysIncPath = NULL;
 745     } else {
 746       if (ufoLastIncPath) free(ufoLastIncPath);
 747       ufoLastIncPath = strdup(".");
 748     }
 749   } else {
 750     char *lslash;
 751     char *cpos;
 752     if (system) {
 753       if (ufoLastSysIncPath) free(ufoLastSysIncPath);
 754       ufoLastSysIncPath = strdup(fname);
 755       lslash = ufoLastSysIncPath;
 756       cpos = ufoLastSysIncPath;
 757     } else {
 758       if (ufoLastIncPath) free(ufoLastIncPath);
 759       ufoLastIncPath = strdup(fname);
 760       lslash = ufoLastIncPath;
 761       cpos = ufoLastIncPath;
 762     }
 763     while (*cpos) {
 764       #ifdef WIN32
 765       if (*cpos == '/' || *cpos == '\\') lslash = cpos;
 766       #else
 767       if (*cpos == '/') lslash = cpos;
 768       #endif
 769       cpos += 1;
 770     }
 771     *lslash = 0;
 772   }
 773 }
 774
 775
 776 //==========================================================================
 777 //
 778 //  ufoClearIncludePath
 779 //
 780 //  required for UrAsm
 781 //
 782 //==========================================================================
 783 void ufoClearIncludePath (void) {
 784   if (ufoLastIncPath != NULL) {
 785     free(ufoLastIncPath);
 786     ufoLastIncPath = NULL;
 787   }
 788   if (ufoLastSysIncPath != NULL) {
 789     free(ufoLastSysIncPath);
 790     ufoLastSysIncPath = NULL;
 791   }
 792 }
 793
 794
 795 //==========================================================================
 796 //
 797 //  ufoErrorPrintFile
 798 //
 799 //==========================================================================
 800 static void ufoErrorPrintFile (FILE *fo, const char *errwarn) {
 801   if (ufoInFileName != NULL) {
 802     fprintf(fo, "UFO %s at file %s, line %d: ", errwarn, ufoInFileName, ufoInFileLine);
 803   } else {
 804     fprintf(fo, "UFO %s somewhere in time: ", errwarn);
 805   }
 806 }
 807
 808
 809 //==========================================================================
 810 //
 811 //  ufoErrorMsgV
 812 //
 813 //==========================================================================
 814 static void ufoErrorMsgV (const char *errwarn, const char *fmt, va_list ap) {
 815   ufoFlushOutput();
 816   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
 817   ufoErrorPrintFile(stderr, errwarn);
 818   vfprintf(stderr, fmt, ap);
 819   va_end(ap);
 820   fputc('\n', stderr);
 821   ufoFlushOutput();
 822 }
 823
 824
 825 //==========================================================================
 826 //
 827 //  ufoWarning
 828 //
 829 //==========================================================================
 830 __attribute__((format(printf, 1, 2)))
 831 void ufoWarning (const char *fmt, ...) {
 832   va_list ap;
 833   va_start(ap, fmt);
 834   ufoErrorMsgV("WARNING", fmt, ap);
 835 }
 836
 837
 838 //==========================================================================
 839 //
 840 //  ufoFatal
 841 //
 842 //==========================================================================
 843 __attribute__((noreturn)) __attribute__((format(printf, 1, 2)))
 844 void ufoFatal (const char *fmt, ...) {
 845   va_list ap;
 846   #ifndef WIN32
 847   ufoDisableRaw();
 848   #endif
 849   va_start(ap, fmt);
 850   ufoErrorMsgV("ERROR", fmt, ap);
 851   if (!ufoInBacktrace) {
 852     ufoInBacktrace = 1;
 853     ufoBacktrace(ufoIP, 1);
 854     ufoInBacktrace = 0;
 855   } else {
 856     fprintf(stderr, "DOUBLE FATAL: error in backtrace!\n");
 857     abort();
 858   }
 859   #ifdef UFO_DEBUG_FATAL_ABORT
 860   abort();
 861   #endif
 862   // allow restart
 863   ufoInRunWord = 0;
 864   ufoVMAbort = 0;
 865   ufoVMStop = 0;
 866   ufoFatalError();
 867 }
 868
 869
 870 // ////////////////////////////////////////////////////////////////////////// //
 871 // working with the stacks
 872 UFO_FORCE_INLINE void ufoPush (uint32_t v) { if (ufoSP >= UFO_DSTACK_SIZE) ufoFatal("data stack overflow"); ufoDStack[ufoSP++] = v; }
 873 UFO_FORCE_INLINE void ufoDrop (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); --ufoSP; }
 874 UFO_FORCE_INLINE uint32_t ufoPop (void) { if (ufoSP == 0) { ufoFatal("data stack underflow"); } return ufoDStack[--ufoSP]; }
 875 UFO_FORCE_INLINE uint32_t ufoPeek (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); return ufoDStack[ufoSP-1u]; }
 876 UFO_FORCE_INLINE void ufoDup (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); ufoPush(ufoDStack[ufoSP-1u]); }
 877 UFO_FORCE_INLINE void ufoOver (void) { if (ufoSP < 2u) ufoFatal("data stack underflow"); ufoPush(ufoDStack[ufoSP-2u]); }
 878 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; }
 879 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; }
 880 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; }
 881
 882 UFO_FORCE_INLINE void ufo2Dup (void) { ufoOver(); ufoOver(); }
 883 UFO_FORCE_INLINE void ufo2Drop (void) { ufoDrop(); ufoDrop(); }
 884 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); }
 885 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; }
 886
 887 UFO_FORCE_INLINE void ufoRPush (uint32_t v) { if (ufoRP >= UFO_RSTACK_SIZE) ufoFatal("return stack overflow"); ufoRStack[ufoRP++] = v; }
 888 UFO_FORCE_INLINE void ufoRDrop (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("return stack underflow"); --ufoRP; }
 889 UFO_FORCE_INLINE uint32_t ufoRPop (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("return stack underflow"); return ufoRStack[--ufoRP]; }
 890 UFO_FORCE_INLINE uint32_t ufoRPeek (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("return stack underflow"); return ufoRStack[ufoRP-1u]; }
 891 UFO_FORCE_INLINE void ufoRDup (void) { if (ufoRP == 0 || ufoRP == ufoRPTop) ufoFatal("return stack underflow"); ufoPush(ufoRStack[ufoRP-1u]); }
 892
 893 UFO_FORCE_INLINE void ufoPushBool (int v) { ufoPush(v ? ufoTrueValue : 0u); }
 894
 895
 896 //==========================================================================
 897 //
 898 //  ufoImgEnsureSize
 899 //
 900 //==========================================================================
 901 static void ufoImgEnsureSize (uint32_t addr) {
 902   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) != 0) ufoFatal("ufoImgEnsureSize: internal error");
 903   if (addr >= ufoImageSize) {
 904     // 64MB should be enough for everyone!
 905     if (addr >= 0x04000000U) {
 906       ufoFatal("image grown too big (addr=0%08XH)", addr);
 907     }
 908     const const uint32_t osz = ufoImageSize;
 909     // grow by 1MB steps
 910     const uint32_t nsz = (addr|0x000fffffU) + 1U;
 911     ufo_assert(nsz > addr);
 912     uint32_t *nimg = realloc(ufoImage, nsz);
 913     if (nimg == NULL) {
 914       ufoFatal("out of memory for UFO image (%u -> %u MBs)",
 915                ufoImageSize / 1024u / 1024u,
 916                nsz / 1024u / 1024u);
 917     }
 918     ufoImage = nimg;
 919     ufoImageSize = nsz;
 920     memset((char *)ufoImage + osz, 0, (nsz - osz));
 921   }
 922 }
 923
 924
 925 //==========================================================================
 926 //
 927 //  ufoImgEnsureTemp
 928 //
 929 //==========================================================================
 930 static void ufoImgEnsureTemp (uint32_t addr) {
 931   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) != 0) ufoFatal("ufoImgEnsureTemp: internal error");
 932   if (addr >= ufoImageTempSize) {
 933     if (addr >= 1024u * 1024u) {
 934       ufoFatal("Forth segmentation fault at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
 935     }
 936     const uint32_t osz = ufoImageTempSize;
 937     // grow by 8KB steps
 938     const uint32_t nsz = (addr|0x00001fffU) + 1U;
 939     uint32_t *nimg = realloc(ufoImageTemp, nsz);
 940     if (nimg == NULL) {
 941       ufoFatal("out of memory for temp UFO image (%u -> %u KBs)",
 942                ufoImageTempSize / 1024u,
 943                nsz / 1024u);
 944     }
 945     ufoImageTemp = nimg;
 946     ufoImageTempSize = nsz;
 947     memset((char *)ufoImageTemp + osz, 0, (nsz - osz));
 948   }
 949 }
 950
 951
 952 #ifdef UFO_FAST_MEM_ACCESS
 953 //==========================================================================
 954 //
 955 //  ufoImgPutU8
 956 //
 957 //  fast
 958 //
 959 //==========================================================================
 960 UFO_FORCE_INLINE void ufoImgPutU8 (uint32_t addr, const uint32_t value) {
 961   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
 962     if (addr >= ufoImageSize) ufoImgEnsureSize(addr);
 963     *((uint8_t *)ufoImage + addr) = (uint8_t)value;
 964   } else if (addr & UFO_ADDR_TEMP_BIT) {
 965     addr &= UFO_ADDR_TEMP_MASK;
 966     if (addr >= ufoImageTempSize) ufoImgEnsureTemp(addr);
 967     *((uint8_t *)ufoImageTemp + addr) = (uint8_t)value;
 968   } else {
 969     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
 970   }
 971 }
 972
 973
 974 //==========================================================================
 975 //
 976 //  ufoImgPutU16
 977 //
 978 //  fast
 979 //
 980 //==========================================================================
 981 UFO_FORCE_INLINE void ufoImgPutU16 (uint32_t addr, const uint32_t value) {
 982   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
 983     if (addr + 1u >= ufoImageSize) ufoImgEnsureSize(addr + 1u);
 984     *(uint16_t *)((uint8_t *)ufoImage + addr) = (uint16_t)value;
 985   } else if (addr & UFO_ADDR_TEMP_BIT) {
 986     addr &= UFO_ADDR_TEMP_MASK;
 987     if (addr + 1u >= ufoImageTempSize) ufoImgEnsureTemp(addr + 1u);
 988     *(uint16_t *)((uint8_t *)ufoImageTemp + addr) = (uint16_t)value;
 989   } else {
 990     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
 991   }
 992 }
 993
 994
 995 //==========================================================================
 996 //
 997 //  ufoImgPutU32
 998 //
 999 //  fast
1000 //
1001 //==========================================================================
1002 UFO_FORCE_INLINE void ufoImgPutU32 (uint32_t addr, const uint32_t value) {
1003   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1004     if (addr + 3u >= ufoImageSize) ufoImgEnsureSize(addr + 3u);
1005     *(uint32_t *)((uint8_t *)ufoImage + addr) = value;
1006   } else if (addr & UFO_ADDR_TEMP_BIT) {
1007     addr &= UFO_ADDR_TEMP_MASK;
1008     if (addr + 3u >= ufoImageTempSize) ufoImgEnsureTemp(addr + 3u);
1009     *(uint32_t *)((uint8_t *)ufoImageTemp + addr) = value;
1010   } else {
1011     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1012   }
1013 }
1014
1015
1016 //==========================================================================
1017 //
1018 //  ufoImgGetU8
1019 //
1020 //  false
1021 //
1022 //==========================================================================
1023 UFO_FORCE_INLINE uint32_t ufoImgGetU8 (uint32_t addr) {
1024   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1025     if (addr >= ufoImageSize) {
1026       // accessing unallocated image area is segmentation fault
1027       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1028     }
1029     return *((const uint8_t *)ufoImage + addr);
1030   } else if (addr & UFO_ADDR_TEMP_BIT) {
1031     addr &= UFO_ADDR_TEMP_MASK;
1032     if (addr >= ufoImageTempSize) {
1033       // accessing unallocated image area is segmentation fault
1034       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1035     }
1036     return *((const uint8_t *)ufoImageTemp + addr);
1037   } else {
1038     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1039   }
1040 }
1041
1042
1043 //==========================================================================
1044 //
1045 //  ufoImgGetU16
1046 //
1047 //  fast
1048 //
1049 //==========================================================================
1050 UFO_FORCE_INLINE uint32_t ufoImgGetU16 (uint32_t addr) {
1051   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1052     if (addr + 1u >= ufoImageSize) {
1053       // accessing unallocated image area is segmentation fault
1054       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1055     }
1056     return *(const uint16_t *)((const uint8_t *)ufoImage + addr);
1057   } else if (addr & UFO_ADDR_TEMP_BIT) {
1058     addr &= UFO_ADDR_TEMP_MASK;
1059     if (addr + 1u >= ufoImageTempSize) {
1060       // accessing unallocated image area is segmentation fault
1061       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1062     }
1063     return *(const uint16_t *)((const uint8_t *)ufoImageTemp + addr);
1064   } else {
1065     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1066   }
1067 }
1068
1069
1070 //==========================================================================
1071 //
1072 //  ufoImgGetU32
1073 //
1074 //  fast
1075 //
1076 //==========================================================================
1077 UFO_FORCE_INLINE uint32_t ufoImgGetU32 (uint32_t addr) {
1078   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1079     if (addr + 3u >= ufoImageSize) {
1080       // accessing unallocated image area is segmentation fault
1081       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1082     }
1083     return *(const uint32_t *)((const uint8_t *)ufoImage + addr);
1084   } else if (addr & UFO_ADDR_TEMP_BIT) {
1085     addr &= UFO_ADDR_TEMP_MASK;
1086     if (addr + 3u >= ufoImageTempSize) {
1087       // accessing unallocated image area is segmentation fault
1088       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1089     }
1090     return *(const uint32_t *)((const uint8_t *)ufoImageTemp + addr);
1091   } else {
1092     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1093   }
1094 }
1095
1096 #else
1097
1098 //==========================================================================
1099 //
1100 //  ufoImgPutU8
1101 //
1102 //  general
1103 //
1104 //==========================================================================
1105 UFO_FORCE_INLINE void ufoImgPutU8 (uint32_t addr, const uint32_t value) {
1106   uint32_t *imgptr;
1107   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1108     if (addr >= ufoImageSize) ufoImgEnsureSize(addr);
1109     imgptr = &ufoImage[addr/4u];
1110   } else if (addr & UFO_ADDR_TEMP_BIT) {
1111     addr &= UFO_ADDR_TEMP_MASK;
1112     if (addr >= ufoImageTempSize) ufoImgEnsureTemp(addr);
1113     imgptr = &ufoImageTemp[addr/4u];
1114   } else {
1115     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1116   }
1117   const uint8_t val = (uint8_t)value;
1118   memcpy((uint8_t *)imgptr + (addr&3), &val, 1);
1119 }
1120
1121
1122 //==========================================================================
1123 //
1124 //  ufoImgPutU16
1125 //
1126 //  general
1127 //
1128 //==========================================================================
1129 UFO_FORCE_INLINE void ufoImgPutU16 (uint32_t addr, const uint32_t value) {
1130   ufoImgPutU8(addr, value&0xffU);
1131   ufoImgPutU8(addr + 1u, (value>>8)&0xffU);
1132 }
1133
1134
1135 //==========================================================================
1136 //
1137 //  ufoImgPutU32
1138 //
1139 //  general
1140 //
1141 //==========================================================================
1142 UFO_FORCE_INLINE void ufoImgPutU32 (uint32_t addr, const uint32_t value) {
1143   ufoImgPutU16(addr, value&0xffffU);
1144   ufoImgPutU16(addr + 2u, (value>>16)&0xffffU);
1145 }
1146
1147
1148 //==========================================================================
1149 //
1150 //  ufoImgGetU8
1151 //
1152 //  general
1153 //
1154 //==========================================================================
1155 UFO_FORCE_INLINE uint32_t ufoImgGetU8 (uint32_t addr) {
1156   uint32_t *imgptr;
1157   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1158     if (addr >= ufoImageSize) return 0;
1159     imgptr = &ufoImage[addr/4u];
1160   } else if (addr & UFO_ADDR_TEMP_BIT) {
1161     addr &= UFO_ADDR_TEMP_MASK;
1162     if (addr >= ufoImageTempSize) return 0;
1163     imgptr = &ufoImageTemp[addr/4u];
1164   } else {
1165     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1166   }
1167   uint8_t val;
1168   memcpy(&val, (uint8_t *)imgptr + (addr&3), 1);
1169   return (uint32_t)val;
1170 }
1171
1172
1173 //==========================================================================
1174 //
1175 //  ufoImgGetU16
1176 //
1177 //  general
1178 //
1179 //==========================================================================
1180 UFO_FORCE_INLINE uint32_t ufoImgGetU16 (uint32_t addr) {
1181   return ufoImgGetU8(addr) | (ufoImgGetU8(addr + 1u) << 8);
1182 }
1183
1184
1185 //==========================================================================
1186 //
1187 //  ufoImgGetU32
1188 //
1189 //  general
1190 //
1191 //==========================================================================
1192 UFO_FORCE_INLINE uint32_t ufoImgGetU32 (uint32_t addr) {
1193   return ufoImgGetU16(addr) | (ufoImgGetU16(addr + 2u) << 16);
1194 }
1195 #endif
1196
1197
1198 //==========================================================================
1199 //
1200 //  ufoEnsureDebugSize
1201 //
1202 //==========================================================================
1203 UFO_DISABLE_INLINE void ufoEnsureDebugSize (uint32_t sdelta) {
1204   ufo_assert(sdelta != 0);
1205   if (ufoDebugImageSize != 0) {
1206     if (ufoDebugImageUsed + sdelta >= 0x40000000U) ufoFatal("debug info too big");
1207     if (ufoDebugImageUsed + sdelta > ufoDebugImageSize) {
1208       // grow by 32KB, this should be more than enough
1209       const uint32_t newsz = ((ufoDebugImageUsed + sdelta) | 0x7fffU) + 1u;
1210       uint8_t *ndb = realloc(ufoDebugImage, newsz);
1211       if (ndb == NULL) ufoFatal("out of memory for debug info");
1212       ufoDebugImage = ndb;
1213       ufoDebugImageSize = newsz;
1214     }
1215   } else {
1216     // initial allocation: 32KB, quite a lot
1217     ufo_assert(ufoDebugImage == NULL);
1218     ufo_assert(ufoDebugImageUsed == 0);
1219     ufoDebugImageSize = 1024 * 32;
1220     ufoDebugImage = malloc(ufoDebugImageSize);
1221     if (ufoDebugImage == NULL) ufoFatal("out of memory for debug info");
1222   }
1223 }
1224
1225
1226 #define UFO_DBG_PUT_U4(val_)  do { \
1227   const uint32_t vv_ = (val_); \
1228   *((uint32_t *)(ufoDebugImage + ufoDebugImageUsed)) = vv_; \
1229   ufoDebugImageUsed += 4u; \
1230 } while (0)
1231
1232
1233 /*
1234   debug info header:
1235     dd lastFileInfoOfs
1236     ...first line info header...
1237   line info header (or reset):
1238     db 0   ; zero line delta
1239     dw followFileInfoSize  ; either it, or 0 if reused
1240     dd fileInfoOfs         ; present only if reused
1241   lines:
1242     dv lineDelta
1243     dv pcBytes
1244
1245   file info record:
1246     dd prevFileInfoOfs
1247     dd fileNameHash
1248     dd nameLen  ; without terminating 0
1249     ...name... (0-terminated)
1250
1251   we will never compare file names: length and hash should provide
1252   good enough unique identifier.
1253
1254 static uint8_t *ufoDebugImage = NULL;
1255 static uint32_t ufoDebugImageUsed = 0; // in bytes
1256 static uint32_t ufoDebugImageSize = 0; // in bytes
1257 static uint32_t ufoDebugFileNameHash = 0; // current file name hash
1258 static uint32_t ufoDebugFileNameLen = 0; // current file name length
1259 static uint32_t ufoDebugCurrDP = 0;
1260 */
1261
1262
1263 //==========================================================================
1264 //
1265 //  ufoSkipDebugVarInt
1266 //
1267 //==========================================================================
1268 static __attribute__((unused)) uint32_t ufoSkipDebugVarInt (uint32_t ofs) {
1269   uint8_t byte;
1270   do {
1271     if (ofs >= ufoDebugImageUsed) ufoFatal("invalid debug data");
1272     byte = ufoDebugImage[ofs]; ofs += 1u;
1273   } while (byte >= 0x80);
1274   return ofs;
1275 }
1276
1277
1278 //==========================================================================
1279 //
1280 //  ufoCalcDebugVarIntSize
1281 //
1282 //==========================================================================
1283 UFO_FORCE_INLINE uint8_t ufoCalcDebugVarIntSize (uint32_t v) {
1284   uint8_t count = 0;
1285   do {
1286     count += 1u;
1287     v >>= 7;
1288   } while (v != 0);
1289   return count;
1290 }
1291
1292
1293 //==========================================================================
1294 //
1295 //  ufoGetDebugVarInt
1296 //
1297 //==========================================================================
1298 static __attribute__((unused)) uint32_t ufoGetDebugVarInt (uint32_t ofs) {
1299   uint32_t v = 0;
1300   uint8_t shift = 0;
1301   uint8_t byte;
1302   do {
1303     if (ofs >= ufoDebugImageUsed) ufoFatal("invalid debug data");
1304     byte = ufoDebugImage[ofs];
1305     v |= (uint32_t)(byte & 0x7f) << shift;
1306     if (byte >= 0x80) {
1307       shift += 7;
1308       ofs += 1u;
1309     }
1310   } while (byte >= 0x80);
1311   return v;
1312 }
1313
1314
1315 //==========================================================================
1316 //
1317 //  ufoPutDebugVarInt
1318 //
1319 //==========================================================================
1320 UFO_FORCE_INLINE void ufoPutDebugVarInt (uint32_t v) {
1321   ufoEnsureDebugSize(5u); // maximum size
1322   do {
1323     if (v >= 0x80) {
1324       ufoDebugImage[ufoDebugImageUsed] = (uint8_t)(v | 0x80u);
1325     } else {
1326       ufoDebugImage[ufoDebugImageUsed] = (uint8_t)v;
1327     }
1328     ufoDebugImageUsed += 1;
1329     v >>= 7;
1330   } while (v != 0);
1331 }
1332
1333
1334 #ifdef UFO_DEBUG_DEBUG
1335 //==========================================================================
1336 //
1337 //  ufoDumpDebugInfo
1338 //
1339 //==========================================================================
1340 static void ufoDumpDebugImage (void) {
1341   #if 0
1342   uint32_t dbgpos = 4u; // first line header info
1343   uint32_t lastline = 0;
1344   uint32_t lastdp = 0;
1345   while (dbgpos < ufoDebugImageUsed) {
1346     if (ufoDebugImage[dbgpos] == 0) {
1347       // new file info
1348       dbgpos += 1u; // skip flag
1349       const uint32_t fhdrSize = *(const uint16_t *)(ufoDebugImage + dbgpos); dbgpos += 2u;
1350       lastdp = ufoGetDebugVarInt(dbgpos);
1351       dbgpos = ufoSkipDebugVarInt(dbgpos);
1352       if (fhdrSize == 0) {
1353         // reused
1354         const uint32_t infoOfs = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1355         fprintf(stderr, "*** OLD FILE: %s\n", (const char *)(ufoDebugImage + infoOfs + 3u * 4u));
1356         fprintf(stderr, "FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + infoOfs))[2]);
1357         fprintf(stderr, "FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + infoOfs))[1]);
1358       } else {
1359         // new
1360         fprintf(stderr, "*** NEW FILE: %s\n", (const char *)(ufoDebugImage + dbgpos + 3u * 4u));
1361         fprintf(stderr, "FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + dbgpos))[2]);
1362         fprintf(stderr, "FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + dbgpos))[1]);
1363       }
1364       dbgpos += fhdrSize;
1365       fprintf(stderr, "LINES-OFS: 0x%08x (hsz: %u -- 0x%08x)\n", dbgpos, fhdrSize, fhdrSize);
1366       lastline = ~(uint32_t)0;
1367     } else {
1368       const uint32_t ln = ufoGetDebugVarInt(dbgpos);
1369       dbgpos = ufoSkipDebugVarInt(dbgpos);
1370       ufo_assert(ln != 0);
1371       lastline += ln;
1372       const uint32_t edp = ufoGetDebugVarInt(dbgpos);
1373       dbgpos = ufoSkipDebugVarInt(dbgpos);
1374       lastdp += edp;
1375       fprintf(stderr, "  line %6u: edp=%u\n", lastline, lastdp);
1376     }
1377   }
1378   #endif
1379 }
1380 #endif
1381
1382
1383 //==========================================================================
1384 //
1385 //  ufoRecordDebugCheckFile
1386 //
1387 //  if we moved to the new file:
1388 //    put "line info header"
1389 //    put new file info (or reuse old)
1390 //
1391 //==========================================================================
1392 UFO_FORCE_INLINE void ufoRecordDebugCheckFile (void) {
1393   if (ufoDebugImageUsed == 0 ||
1394       ufoDebugFileNameLen != ufoInFileNameLen ||
1395       ufoDebugFileNameHash != ufoInFileNameHash)
1396   {
1397     // new file record (or reuse old one)
1398     const int initial = (ufoDebugImageUsed == 0);
1399     uint32_t fileRec = 0;
1400     // try to find and old one
1401     if (!initial) {
1402       fileRec = *(const uint32_t *)ufoDebugImage;
1403       #if 0
1404       fprintf(stderr, "*** NEW-FILE(%u): 0x%08x: <%s> (frec=0x%08x)\n", ufoInFileNameLen,
1405               ufoInFileNameHash, ufoInFileName, fileRec);
1406       #endif
1407       while (fileRec != 0 &&
1408              (ufoInFileNameLen != ((const uint32_t *)(ufoDebugImage + fileRec))[1] ||
1409               ufoInFileNameHash != ((const uint32_t *)(ufoDebugImage + fileRec))[2]))
1410       {
1411         #if 0
1412         fprintf(stderr, "*** FRCHECK: 0x%08x\n", fileRec);
1413         fprintf(stderr, "  FILE NAME: %s\n", (const char *)(ufoDebugImage + fileRec + 3u * 4u));
1414         fprintf(stderr, "  FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + fileRec))[2]);
1415         fprintf(stderr, "  FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + fileRec))[1]);
1416         fprintf(stderr, "  FILE PREV: 0x%08x\n", *(const uint32_t *)(ufoDebugImage + fileRec));
1417         #endif
1418         fileRec = *(const uint32_t *)(ufoDebugImage + fileRec);
1419       }
1420       #if 0
1421       fprintf(stderr, "*** FRCHECK-DONE: 0x%08x\n", fileRec);
1422       if (fileRec != 0) {
1423         fprintf(stderr, "    FILE NAME: %s\n", (const char *)(ufoDebugImage + fileRec + 3u * 4u));
1424         fprintf(stderr, "    FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + fileRec))[2]);
1425         fprintf(stderr, "    FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + fileRec))[1]);
1426         fprintf(stderr, "    FILE PREV: 0x%08x\n", *(const uint32_t *)(ufoDebugImage + fileRec));
1427       }
1428       #endif
1429     } else {
1430       ufoEnsureDebugSize(8u);
1431       *(uint32_t *)ufoDebugImage = 0;
1432     }
1433     // write "line info header"
1434     if (fileRec != 0) {
1435       ufoEnsureDebugSize(32u);
1436       ufoDebugImage[ufoDebugImageUsed] = 0; ufoDebugImageUsed += 1u; // header flag (0 delta)
1437       // file record size: 0 (reused)
1438       *((uint16_t *)(ufoDebugImage + ufoDebugImageUsed)) = 0; ufoDebugImageUsed += 2u;
1439       // put last DP
1440       ufoPutDebugVarInt(ufoDebugCurrDP);
1441       // file info offset
1442       UFO_DBG_PUT_U4(fileRec);
1443     } else {
1444       // name, trailing 0 byte, 3 dword fields
1445       const uint32_t finfoSize = ufoInFileNameLen + 1u + 3u * 4u;
1446       ufo_assert(finfoSize < 65536u);
1447       ufoEnsureDebugSize(finfoSize + 32u);
1448       if (initial) {
1449         *(uint32_t *)ufoDebugImage = 0;
1450         ufoDebugImageUsed = 4;
1451       }
1452       ufoDebugImage[ufoDebugImageUsed] = 0; ufoDebugImageUsed += 1u; // header flag (0 delta)
1453       // file record size
1454       *((uint16_t *)(ufoDebugImage + ufoDebugImageUsed)) = (uint16_t)finfoSize; ufoDebugImageUsed += 2u;
1455       // put last DP
1456       ufoPutDebugVarInt(ufoDebugCurrDP);
1457       // file record follows
1458       // fix file info offsets
1459       uint32_t lastOfs = *(const uint32_t *)ufoDebugImage;
1460       *(uint32_t *)ufoDebugImage = ufoDebugImageUsed;
1461       UFO_DBG_PUT_U4(lastOfs);
1462       // save file info hash
1463       UFO_DBG_PUT_U4(ufoInFileNameHash);
1464       // save file info length
1465       UFO_DBG_PUT_U4(ufoInFileNameLen);
1466       // save file name
1467       if (ufoInFileNameLen != 0) {
1468         memcpy(ufoDebugImage + ufoDebugImageUsed, ufoInFileName, ufoInFileNameLen + 1u);
1469         ufoDebugImageUsed += ufoInFileNameLen + 1u;
1470       } else {
1471         ufoDebugImage[ufoDebugImageUsed] = 0; ufoDebugImageUsed += 1u;
1472       }
1473     }
1474     ufoDebugFileNameLen = ufoInFileNameLen;
1475     ufoDebugFileNameHash = ufoInFileNameHash;
1476     ufoDebugLastLine = ~(uint32_t)0;
1477     ufoDebugLastLinePCOfs = 0;
1478     ufoDebugLastLineDP = ufoDebugCurrDP;
1479   }
1480 }
1481
1482
1483 //==========================================================================
1484 //
1485 //  ufoRecordDebugRecordLine
1486 //
1487 //==========================================================================
1488 UFO_FORCE_INLINE void ufoRecordDebugRecordLine (uint32_t line, uint32_t newhere) {
1489   if (line == ufoDebugLastLine) {
1490     ufo_assert(ufoDebugLastLinePCOfs != 0);
1491     ufoDebugImageUsed = ufoDebugLastLinePCOfs;
1492   } else {
1493     #if 0
1494     fprintf(stderr, "FL-NEW-LINE(0x%08x): <%s>; new line: %u (old: %u)\n",
1495             ufoDebugImageUsed,
1496             ufoInFileName, line, ufoDebugLastLine);
1497     #endif
1498     ufoPutDebugVarInt(line - ufoDebugLastLine);
1499     ufoDebugLastLinePCOfs = ufoDebugImageUsed;
1500     ufoDebugLastLine = line;
1501     ufoDebugLastLineDP = ufoDebugCurrDP;
1502   }
1503   ufoPutDebugVarInt(newhere - ufoDebugLastLineDP);
1504   ufoDebugCurrDP = newhere;
1505 }
1506
1507
1508 //==========================================================================
1509 //
1510 //  ufoRecordDebug
1511 //
1512 //==========================================================================
1513 UFO_DISABLE_INLINE void ufoRecordDebug (uint32_t newhere) {
1514   if (newhere > ufoDebugCurrDP) {
1515     uint32_t ln = (uint32_t)ufoInFileLine;
1516     if (ln == ~(uint32_t)0) ln = 0;
1517     #if 0
1518     fprintf(stderr, "FL: <%s>; line: %d\n", ufoInFileName, ufoInFileLine);
1519     #endif
1520     ufoRecordDebugCheckFile();
1521     ufoRecordDebugRecordLine(ln, newhere);
1522   }
1523 }
1524
1525
1526 //==========================================================================
1527 //
1528 //  ufoGetWordEndAddrYFA
1529 //
1530 //==========================================================================
1531 static uint32_t ufoGetWordEndAddrYFA (uint32_t yfa) {
1532   if (yfa > 8u) {
1533     const uint32_t oyfa = yfa;
1534     yfa = ufoImgGetU32(yfa);
1535     if (yfa == 0) {
1536       if ((oyfa & UFO_ADDR_TEMP_BIT) == 0) {
1537         yfa = UFO_GET_DP();
1538         if ((yfa & UFO_ADDR_TEMP_BIT) != 0) {
1539           yfa = UFO_CFA_TO_PFA(UFO_NFA_TO_CFA(UFO_YFA_TO_NFA(oyfa)));
1540         }
1541       } else {
1542         yfa = UFO_CFA_TO_PFA(UFO_NFA_TO_CFA(UFO_YFA_TO_NFA(oyfa)));
1543       }
1544     } else {
1545       yfa = UFO_YFA_TO_WST(yfa);
1546     }
1547   } else {
1548     yfa = 0;
1549   }
1550   return yfa;
1551 }
1552
1553
1554 //==========================================================================
1555 //
1556 //  ufoGetWordEndAddr
1557 //
1558 //==========================================================================
1559 static uint32_t ufoGetWordEndAddr (const uint32_t cfa) {
1560   if (cfa != 0) {
1561     return ufoGetWordEndAddrYFA(UFO_LFA_TO_YFA(UFO_CFA_TO_LFA(cfa)));
1562   } else {
1563     return 0;
1564   }
1565 }
1566
1567
1568 //==========================================================================
1569 //
1570 //  ufoFindWordForIP
1571 //
1572 //  return NFA or 0
1573 //
1574 //  WARNING: this is SLOW!
1575 //
1576 //==========================================================================
1577 static uint32_t ufoFindWordForIP (const uint32_t ip) {
1578   uint32_t res = 0;
1579   if (ip != 0) {
1580     //fprintf(stderr, "ufoFindWordForIP:000: ip=0x%08x\n", ip);
1581     // iterate over all words
1582     uint32_t xfa = ufoImgGetU32(ufoAddrLastXFA);
1583     //fprintf(stderr, "ufoFindWordForIP:001: xfa=0x%08x\n", xfa);
1584     if (xfa != 0) {
1585       while (res == 0 && xfa != 0) {
1586         const uint32_t yfa = UFO_XFA_TO_YFA(xfa);
1587         const uint32_t wst = UFO_YFA_TO_WST(yfa);
1588         //fprintf(stderr, "ufoFindWordForIP:002:   yfa=0x%08x; wst=0x%08x\n", yfa, wst);
1589         const uint32_t wend = ufoGetWordEndAddrYFA(yfa);
1590         if (ip >= wst && ip < wend) {
1591           res = UFO_YFA_TO_NFA(yfa);
1592         } else {
1593           xfa = ufoImgGetU32(xfa);
1594         }
1595       }
1596     }
1597   }
1598   return res;
1599 }
1600
1601
1602 //==========================================================================
1603 //
1604 //  ufoFindFileForIP
1605 //
1606 //  return file name or `NULL`
1607 //
1608 //  WARNING: this is SLOW!
1609 //
1610 //==========================================================================
1611 static const char *ufoFindFileForIP (uint32_t ip, uint32_t *line,
1612                                      uint32_t *nlen, uint32_t *nhash)
1613 {
1614   if (ip != 0 && ufoDebugImageUsed != 0) {
1615     const char *filename = NULL;
1616     uint32_t dbgpos = 4u; // first line header info
1617     uint32_t lastline = 0;
1618     uint32_t lastdp = 0;
1619     uint32_t namelen = 0;
1620     uint32_t namehash = 0;
1621     while (dbgpos < ufoDebugImageUsed) {
1622       if (ufoDebugImage[dbgpos] == 0) {
1623         // new file info
1624         dbgpos += 1u; // skip flag
1625         const uint32_t fhdrSize = *(const uint16_t *)(ufoDebugImage + dbgpos); dbgpos += 2u;
1626         lastdp = ufoGetDebugVarInt(dbgpos);
1627         dbgpos = ufoSkipDebugVarInt(dbgpos);
1628         uint32_t infoOfs;
1629         if (fhdrSize == 0) {
1630           // reused
1631           infoOfs = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1632         } else {
1633           // new
1634           infoOfs = dbgpos;
1635         }
1636         filename = (const char *)(ufoDebugImage + infoOfs + 3u * 4u);
1637         namelen = ((const uint32_t *)(ufoDebugImage + infoOfs))[2];
1638         namehash = ((const uint32_t *)(ufoDebugImage + infoOfs))[1];
1639         if (filename[0] == 0) filename = NULL;
1640         dbgpos += fhdrSize;
1641         lastline = ~(uint32_t)0;
1642       } else {
1643         const uint32_t ln = ufoGetDebugVarInt(dbgpos);
1644         dbgpos = ufoSkipDebugVarInt(dbgpos);
1645         ufo_assert(ln != 0);
1646         lastline += ln;
1647         const uint32_t edp = ufoGetDebugVarInt(dbgpos);
1648         dbgpos = ufoSkipDebugVarInt(dbgpos);
1649         if (ip >= lastdp && ip < lastdp + edp) {
1650           if (line) *line = lastline;
1651           if (nlen) *nlen = namelen;
1652           if (nhash) *nhash = namehash;
1653           return filename;
1654         }
1655         lastdp += edp;
1656       }
1657     }
1658   }
1659   if (line) *line = 0;
1660   if (nlen) *nlen = 0;
1661   if (nhash) *nlen = 0;
1662   return NULL;
1663 }
1664
1665
1666 //==========================================================================
1667 //
1668 //  ufoBumpDP
1669 //
1670 //==========================================================================
1671 UFO_FORCE_INLINE void ufoBumpDP (uint32_t delta) {
1672   uint32_t dp = ufoImgGetU32(ufoAddrDPTemp);
1673   if (dp == 0) {
1674     dp = ufoImgGetU32(ufoAddrDP);
1675     if ((dp & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(dp + delta);
1676     dp += delta;
1677     ufoImgPutU32(ufoAddrDP, dp);
1678   } else {
1679     dp = ufoImgGetU32(ufoAddrDPTemp);
1680     if ((dp & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(dp + delta);
1681     dp += delta;
1682     ufoImgPutU32(ufoAddrDPTemp, dp);
1683   }
1684 }
1685
1686
1687 //==========================================================================
1688 //
1689 //  ufoImgEmitU8
1690 //
1691 //==========================================================================
1692 UFO_FORCE_INLINE void ufoImgEmitU8 (uint32_t value) {
1693   ufoImgPutU8(UFO_GET_DP(), value);
1694   ufoBumpDP(1);
1695 }
1696
1697
1698 //==========================================================================
1699 //
1700 //  ufoImgEmitU32
1701 //
1702 //==========================================================================
1703 UFO_FORCE_INLINE void ufoImgEmitU32 (uint32_t value) {
1704   ufoImgPutU32(UFO_GET_DP(), value);
1705   ufoBumpDP(4);
1706 }
1707
1708
1709 #ifdef UFO_FAST_MEM_ACCESS
1710
1711 //==========================================================================
1712 //
1713 //  ufoImgEmitU32_NoInline
1714 //
1715 //  false
1716 //
1717 //==========================================================================
1718 UFO_FORCE_INLINE void ufoImgEmitU32_NoInline (uint32_t value) {
1719   ufoImgPutU32(UFO_GET_DP(), value);
1720   ufoBumpDP(4);
1721 }
1722
1723 #else
1724
1725 //==========================================================================
1726 //
1727 //  ufoImgEmitU32_NoInline
1728 //
1729 //  general
1730 //
1731 //==========================================================================
1732 UFO_DISABLE_INLINE void ufoImgEmitU32_NoInline (uint32_t value) {
1733   ufoImgPutU32(UFO_GET_DP(), value);
1734   ufoBumpDP(4);
1735 }
1736
1737 #endif
1738
1739
1740 //==========================================================================
1741 //
1742 //  ufoImgGetU8Ext
1743 //
1744 //  this understands handle addresses
1745 //
1746 //==========================================================================
1747 UFO_FORCE_INLINE uint32_t ufoImgGetU8Ext (uint32_t addr) {
1748   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
1749     return ufoImgGetU8(addr);
1750   } else {
1751     ufoPush(0);
1752     ufoPush(addr);
1753     UFCALL(PAR_HANDLE_LOAD_BYTE);
1754     return ufoPop();
1755   }
1756 }
1757
1758
1759 //==========================================================================
1760 //
1761 //  ufoImgPutU8Ext
1762 //
1763 //  this understands handle addresses
1764 //
1765 //==========================================================================
1766 UFO_FORCE_INLINE void ufoImgPutU8Ext (uint32_t addr, uint32_t value) {
1767   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
1768     ufoImgPutU8(addr, value);
1769   } else {
1770     ufoPush(value);
1771     ufoPush(0);
1772     ufoPush(addr);
1773     UFCALL(PAR_HANDLE_STORE_BYTE);
1774   }
1775 }
1776
1777
1778 //==========================================================================
1779 //
1780 //  ufoImgEmitAlign
1781 //
1782 //==========================================================================
1783 UFO_FORCE_INLINE void ufoImgEmitAlign (void) {
1784   while ((UFO_GET_DP() & 3) != 0) ufoImgEmitU8(0);
1785 }
1786
1787
1788 //==========================================================================
1789 //
1790 //  ufoResetTib
1791 //
1792 //==========================================================================
1793 UFO_FORCE_INLINE void ufoResetTib (void) {
1794   uint32_t defTIB = ufoImgGetU32(ufoAddrDefTIB);
1795   //fprintf(stderr, "ufoResetTib(%p): defTIB=0x%08x\n", ufoCurrState, defTIB);
1796   if (defTIB == 0) {
1797     // create new TIB handle
1798     UfoHandle *tibh = ufoAllocHandle(0x69a029a6); // arbitrary number
1799     defTIB = tibh->ufoHandle;
1800     ufoImgPutU32(ufoAddrDefTIB, defTIB);
1801   }
1802   if ((defTIB & UFO_ADDR_HANDLE_BIT) != 0) {
1803     UfoHandle *hh = ufoGetHandle(defTIB);
1804     if (hh == NULL) ufoFatal("default TIB is not allocated");
1805     if (hh->size == 0) {
1806       ufo_assert(hh->data == NULL);
1807       hh->data = calloc(1, UFO_ADDR_HANDLE_OFS_MASK + 1);
1808       if (hh->data == NULL) ufoFatal("out of memory for default TIB");
1809       hh->size = UFO_ADDR_HANDLE_OFS_MASK + 1;
1810     }
1811   }
1812   const uint32_t oldA = ufoRegA;
1813   ufoImgPutU32(ufoAddrTIBx, defTIB);
1814   ufoImgPutU32(ufoAddrINx, 0);
1815   ufoRegA = defTIB;
1816   ufoPush(0); // value
1817   ufoPush(0); // offset
1818   UFCALL(CPOKE_REGA_IDX);
1819   ufoRegA = oldA;
1820 }
1821
1822
1823 //==========================================================================
1824 //
1825 //  ufoTibEnsureSize
1826 //
1827 //==========================================================================
1828 UFO_DISABLE_INLINE void ufoTibEnsureSize (uint32_t size) {
1829   if (size > 1024u * 1024u * 256u) ufoFatal("TIB size too big");
1830   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
1831   //fprintf(stderr, "ufoTibEnsureSize: TIB=0x%08x; size=%u\n", tib, size);
1832   if ((tib & UFO_ADDR_HANDLE_BIT) != 0) {
1833     UfoHandle *hh = ufoGetHandle(tib);
1834     if (hh == NULL) {
1835       ufoFatal("cannot resize TIB, TIB is not a handle");
1836     }
1837     if (hh->size < size) {
1838       const uint32_t newsz = (size | 0xfffU) + 1u;
1839       uint8_t *nx = realloc(hh->data, newsz);
1840       if (nx == NULL) ufoFatal("out of memory for restored TIB");
1841       hh->data = nx;
1842       hh->size = newsz;
1843     }
1844   }
1845   #if 0
1846   else {
1847     ufoFatal("cannot resize TIB, TIB is not a handle (0x%08x)", tib);
1848   }
1849   #endif
1850 }
1851
1852
1853 //==========================================================================
1854 //
1855 //  ufoTibGetSize
1856 //
1857 //==========================================================================
1858 /*
1859 UFO_DISABLE_INLINE uint32_t ufoTibGetSize (void) {
1860   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
1861   if ((tib & UFO_ADDR_HANDLE_BIT) == 0) {
1862     ufoFatal("cannot query TIB, TIB is not a handle");
1863   }
1864   UfoHandle *hh = ufoGetHandle(tib);
1865   if (hh == NULL) {
1866     ufoFatal("cannot query TIB, TIB is not a handle");
1867   }
1868   return hh->size;
1869 }
1870 */
1871
1872
1873 //==========================================================================
1874 //
1875 //  ufoTibPeekCh
1876 //
1877 //==========================================================================
1878 UFO_FORCE_INLINE uint8_t ufoTibPeekCh (void) {
1879   return (uint8_t)ufoImgGetU8Ext(ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx));
1880 }
1881
1882
1883 //==========================================================================
1884 //
1885 //  ufoTibPeekChOfs
1886 //
1887 //==========================================================================
1888 UFO_FORCE_INLINE uint8_t ufoTibPeekChOfs (uint32_t ofs) {
1889   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
1890   if (ofs <= UFO_ADDR_HANDLE_OFS_MASK || (tib & UFO_ADDR_HANDLE_BIT) == 0) {
1891     return (uint8_t)ufoImgGetU8Ext(tib + ufoImgGetU32(ufoAddrINx) + ofs);
1892   } else {
1893     return 0;
1894   }
1895 }
1896
1897
1898 //==========================================================================
1899 //
1900 //  ufoTibPokeChOfs
1901 //
1902 //==========================================================================
1903 UFO_DISABLE_INLINE void ufoTibPokeChOfs (uint8_t ch, uint32_t ofs) {
1904   const uint32_t oldA = ufoRegA;
1905   ufoRegA = ufoImgGetU32(ufoAddrTIBx);
1906   ufoPush(ch);
1907   ufoPush(ufoImgGetU32(ufoAddrINx) + ofs);
1908   UFCALL(CPOKE_REGA_IDX);
1909   ufoRegA = oldA;
1910 }
1911
1912
1913 //==========================================================================
1914 //
1915 //  ufoTibGetCh
1916 //
1917 //==========================================================================
1918 UFO_FORCE_INLINE uint8_t ufoTibGetCh (void) {
1919   const uint8_t ch = ufoTibPeekCh();
1920   if (ch) ufoImgPutU32(ufoAddrINx, ufoImgGetU32(ufoAddrINx) + 1u);
1921   return ch;
1922 }
1923
1924
1925 //==========================================================================
1926 //
1927 //  ufoTibSkipCh
1928 //
1929 //==========================================================================
1930 UFO_FORCE_INLINE void ufoTibSkipCh (void) {
1931   (void)ufoTibGetCh();
1932 }
1933
1934
1935 // ////////////////////////////////////////////////////////////////////////// //
1936 // native CFA implementations
1937 //
1938
1939 //==========================================================================
1940 //
1941 //  ufoDoForth
1942 //
1943 //==========================================================================
1944 static void ufoDoForth (uint32_t pfa) {
1945   ufoRPush(ufoIP);
1946   ufoIP = pfa;
1947 }
1948
1949
1950 //==========================================================================
1951 //
1952 //  ufoDoVariable
1953 //
1954 //==========================================================================
1955 static void ufoDoVariable (uint32_t pfa) {
1956   ufoPush(pfa);
1957 }
1958
1959
1960 //==========================================================================
1961 //
1962 //  ufoDoUserVariable
1963 //
1964 //==========================================================================
1965 static void ufoDoUserVariable (uint32_t pfa) {
1966   ufoPush(ufoImgGetU32(pfa));
1967 }
1968
1969
1970 //==========================================================================
1971 //
1972 //  ufoDoValue
1973 //
1974 //==========================================================================
1975 static void ufoDoValue (uint32_t pfa) {
1976   ufoPush(ufoImgGetU32(pfa));
1977 }
1978
1979
1980 //==========================================================================
1981 //
1982 //  ufoDoConst
1983 //
1984 //==========================================================================
1985 static void ufoDoConst (uint32_t pfa) {
1986   ufoPush(ufoImgGetU32(pfa));
1987 }
1988
1989
1990 //==========================================================================
1991 //
1992 //  ufoDoDefer
1993 //
1994 //==========================================================================
1995 static void ufoDoDefer (uint32_t pfa) {
1996   const uint32_t cfa = ufoImgGetU32(pfa);
1997   if (cfa != 0) {
1998     ufoRPush(cfa);
1999     ufoVMRPopCFA = 1;
2000   }
2001 }
2002
2003
2004 //==========================================================================
2005 //
2006 //  ufoDoVoc
2007 //
2008 //==========================================================================
2009 static void ufoDoVoc (uint32_t pfa) {
2010   ufoImgPutU32(ufoAddrContext, ufoImgGetU32(pfa));
2011 }
2012
2013
2014 //==========================================================================
2015 //
2016 //  ufoDoCreate
2017 //
2018 //==========================================================================
2019 static void ufoDoCreate (uint32_t pfa) {
2020   ufoPush(pfa);
2021 }
2022
2023
2024 //==========================================================================
2025 //
2026 //  ufoPushInFile
2027 //
2028 //  this also increments last used file id
2029 //
2030 //==========================================================================
2031 static void ufoPushInFile (void) {
2032   if (ufoFileStackPos >= UFO_MAX_NESTED_INCLUDES) ufoFatal("too many includes");
2033   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
2034   stk->fl = ufoInFile;
2035   stk->fname = ufoInFileName;
2036   stk->fline = ufoInFileLine;
2037   stk->id = ufoFileId;
2038   stk->incpath = (ufoLastIncPath ? strdup(ufoLastIncPath) : NULL);
2039   stk->sysincpath = (ufoLastSysIncPath ? strdup(ufoLastSysIncPath) : NULL);
2040   ufoFileStackPos += 1;
2041   ufoInFile = NULL;
2042   ufoInFileName = NULL; ufoInFileNameLen = 0; ufoInFileNameHash = 0;
2043   ufoInFileLine = 0;
2044   ufoLastUsedFileId += 1;
2045   ufo_assert(ufoLastUsedFileId != 0); // just in case ;-)
2046   //ufoLastIncPath = NULL;
2047 }
2048
2049
2050 //==========================================================================
2051 //
2052 //  ufoWipeIncludeStack
2053 //
2054 //==========================================================================
2055 static void ufoWipeIncludeStack (void) {
2056   if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
2057   if (ufoInFile) { fclose(ufoInFile); ufoInFile = NULL; }
2058   if (ufoLastIncPath) { free(ufoLastIncPath); ufoLastIncPath = NULL; }
2059   if (ufoLastSysIncPath) { free(ufoLastSysIncPath); ufoLastSysIncPath = NULL; }
2060   while (ufoFileStackPos != 0) {
2061     ufoFileStackPos -= 1;
2062     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
2063     if (stk->fl) fclose(stk->fl);
2064     if (stk->fname) free(stk->fname);
2065     if (stk->incpath) free(stk->incpath);
2066   }
2067 }
2068
2069
2070 //==========================================================================
2071 //
2072 //  ufoPopInFile
2073 //
2074 //==========================================================================
2075 static void ufoPopInFile (void) {
2076   if (ufoFileStackPos == 0) ufoFatal("trying to pop include from empty stack");
2077   if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
2078   if (ufoInFile) { fclose(ufoInFile); ufoInFile = NULL; }
2079   if (ufoLastIncPath) { free(ufoLastIncPath); ufoLastIncPath = NULL; }
2080   if (ufoLastSysIncPath) { free(ufoLastSysIncPath); ufoLastSysIncPath = NULL; }
2081   ufoFileStackPos -= 1;
2082   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
2083   ufoInFile = stk->fl;
2084   ufoSetInFileNameReuse(stk->fname);
2085   ufoInFileLine = stk->fline;
2086   ufoLastIncPath = stk->incpath;
2087   ufoLastSysIncPath = stk->sysincpath;
2088   ufoFileId = stk->id;
2089   ufoResetTib();
2090   #ifdef UFO_DEBUG_INCLUDE
2091   if (ufoInFileName == NULL) {
2092     fprintf(stderr, "INC-POP: no more files.\n");
2093   } else {
2094     fprintf(stderr, "INC-POP: fname: %s\n", ufoInFileName);
2095   }
2096   #endif
2097 }
2098
2099
2100 //==========================================================================
2101 //
2102 //  ufoDeinit
2103 //
2104 //==========================================================================
2105 void ufoDeinit (void) {
2106   #ifdef UFO_DEBUG_WRITE_MAIN_IMAGE
2107   {
2108     FILE *fo = fopen("zufo_main.img", "w");
2109     uint32_t dpTemp = ufoImgGetU32(ufoAddrDPTemp);
2110     uint32_t dpMain = ufoImgGetU32(ufoAddrDP);
2111     if ((dpMain & UFO_ADDR_SPECIAL_BITS_MASK) != 0) dpMain = ufoImageSize;
2112     if (dpTemp != 0 && (dpTemp & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
2113       if (dpTemp > dpMain) dpMain = dpTemp;
2114     }
2115     fwrite(ufoImage, dpMain, 1, fo);
2116     fclose(fo);
2117   }
2118   #endif
2119
2120   #ifdef UFO_DEBUG_WRITE_DEBUG_IMAGE
2121   {
2122     FILE *fo = fopen("zufo_debug.img", "w");
2123     fwrite(ufoDebugImage, ufoDebugImageUsed, 1, fo);
2124     fclose(fo);
2125   }
2126   #endif
2127
2128   #ifdef UFO_DEBUG_DEBUG
2129   {
2130     uint32_t dpTemp = ufoImgGetU32(ufoAddrDPTemp);
2131     uint32_t dpMain = ufoImgGetU32(ufoAddrDP);
2132     if ((dpMain & UFO_ADDR_SPECIAL_BITS_MASK) != 0) dpMain = ufoImageSize;
2133     if (dpTemp != 0 && (dpTemp & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
2134       if (dpTemp > dpMain) dpMain = dpTemp;
2135     }
2136     fprintf(stderr, "UFO: image used: %u; size: %u\n",
2137             dpMain, ufoImageSize);
2138     fprintf(stderr, "UFO: debug image used: %u; size: %u\n",
2139             ufoDebugImageUsed, ufoDebugImageSize);
2140     ufoDumpDebugImage();
2141   }
2142   #endif
2143
2144   // free all states
2145   ufoCurrState = NULL;
2146   ufoYieldedState = NULL;
2147   ufoDebuggerState = NULL;
2148   for (uint32_t fidx = 0; fidx < (uint32_t)(UFO_MAX_STATES/32); fidx += 1u) {
2149     uint32_t bmp = ufoStateUsedBitmap[fidx];
2150     if (bmp != 0) {
2151       uint32_t stid = fidx * 32u;
2152       while (bmp != 0) {
2153         if ((bmp & 0x01) != 0) ufoFreeState(ufoStateMap[stid]);
2154         stid += 1u; bmp >>= 1;
2155       }
2156     }
2157   }
2158
2159   free(ufoDebugImage);
2160   ufoDebugImage = NULL;
2161   ufoDebugImageUsed = 0;
2162   ufoDebugImageSize = 0;
2163   ufoDebugFileNameHash = 0;
2164   ufoDebugFileNameLen = 0;
2165   ufoDebugLastLine = 0;
2166   ufoDebugLastLinePCOfs = 0;
2167   ufoDebugLastLineDP = 0;
2168   ufoDebugCurrDP = 0;
2169
2170   ufoInBacktrace = 0;
2171   ufoClearCondDefines();
2172   ufoWipeIncludeStack();
2173
2174   // release all includes
2175   ufoInFile = NULL;
2176   if (ufoInFileName) free(ufoInFileName);
2177   if (ufoLastIncPath) free(ufoLastIncPath);
2178   if (ufoLastSysIncPath) free(ufoLastSysIncPath);
2179   ufoInFileName = NULL; ufoLastIncPath = NULL; ufoLastSysIncPath = NULL;
2180   ufoInFileNameHash = 0; ufoInFileNameLen = 0;
2181   ufoInFileLine = 0;
2182
2183   free(ufoForthCFAs);
2184   ufoForthCFAs = NULL;
2185   ufoCFAsUsed = 0;
2186
2187   free(ufoImage);
2188   ufoImage = NULL;
2189   ufoImageSize = 0;
2190
2191   ufoMode = UFO_MODE_NATIVE;
2192   ufoForthVocId = 0; ufoCompilerVocId = 0;
2193   ufoSingleStep = 0;
2194
2195   // free all handles
2196   for (uint32_t f = 0; f < ufoHandlesUsed; f += 1) {
2197     UfoHandle *hh = ufoHandles[f];
2198     if (hh != NULL) {
2199       if (hh->data != NULL) free(hh->data);
2200       free(hh);
2201     }
2202   }
2203   if (ufoHandles != NULL) free(ufoHandles);
2204   ufoHandles = NULL; ufoHandlesUsed = 0; ufoHandlesAlloted = 0;
2205   ufoHandleFreeList = NULL;
2206
2207   ufoLastEmitWasCR = 1;
2208
2209   ufoClearCondDefines();
2210 }
2211
2212
2213 //==========================================================================
2214 //
2215 //  ufoDumpWordHeader
2216 //
2217 //==========================================================================
2218 __attribute__((unused)) static void ufoDumpWordHeader (const uint32_t lfa) {
2219   fprintf(stderr, "=== WORD: LFA: 0x%08x ===\n", lfa);
2220   if (lfa != 0) {
2221     fprintf(stderr, "  (XFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_XFA(lfa)));
2222     fprintf(stderr, "  (YFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_YFA(lfa)));
2223     fprintf(stderr, "  (BFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_BFA(lfa)));
2224     fprintf(stderr, "  (LFA): 0x%08x\n", ufoImgGetU32(lfa));
2225     fprintf(stderr, "  (NHH): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)));
2226     const uint32_t cfa = UFO_LFA_TO_CFA(lfa);
2227     fprintf(stderr, "    CFA: 0x%08x\n", cfa);
2228     fprintf(stderr, "    PFA: 0x%08x\n", UFO_CFA_TO_PFA(cfa));
2229     fprintf(stderr, "  (CFA): 0x%08x\n", ufoImgGetU32(cfa));
2230     const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
2231     const uint32_t nlen = ufoImgGetU8(nfa);
2232     fprintf(stderr, "    NFA: 0x%08x  (nlen: %u)\n", nfa, nlen);
2233     const uint32_t flags = ufoImgGetU32(nfa);
2234     fprintf(stderr, "  FLAGS: 0x%08x\n", flags);
2235     if ((flags & 0xffff0000U) != 0) {
2236       fprintf(stderr, "  FLAGS:");
2237       if (flags & UFW_FLAG_IMMEDIATE) fprintf(stderr, " IMM");
2238       if (flags & UFW_FLAG_SMUDGE) fprintf(stderr, " SMUDGE");
2239       if (flags & UFW_FLAG_NORETURN) fprintf(stderr, " NORET");
2240       if (flags & UFW_FLAG_HIDDEN) fprintf(stderr, " HIDDEN");
2241       if (flags & UFW_FLAG_CBLOCK) fprintf(stderr, " CBLOCK");
2242       if (flags & UFW_FLAG_VOCAB) fprintf(stderr, " VOCAB");
2243       if (flags & UFW_FLAG_SCOLON) fprintf(stderr, " SCOLON");
2244       if (flags & UFW_FLAG_PROTECTED) fprintf(stderr, " PROTECTED");
2245       fputc('\n', stderr);
2246     }
2247     if ((flags & 0xff00U) != 0) {
2248       fprintf(stderr, "   ARGS: ");
2249       switch (flags & UFW_WARG_MASK) {
2250         case UFW_WARG_NONE: fprintf(stderr, "NONE"); break;
2251         case UFW_WARG_BRANCH: fprintf(stderr, "BRANCH"); break;
2252         case UFW_WARG_LIT: fprintf(stderr, "LIT"); break;
2253         case UFW_WARG_C4STRZ: fprintf(stderr, "C4STRZ"); break;
2254         case UFW_WARG_CFA: fprintf(stderr, "CFA"); break;
2255         case UFW_WARG_CBLOCK: fprintf(stderr, "CBLOCK"); break;
2256         case UFW_WARG_VOCID: fprintf(stderr, "VOCID"); break;
2257         case UFW_WARG_C1STRZ: fprintf(stderr, "C1STRZ"); break;
2258         case UFW_WARG_DATASKIP: fprintf(stderr, "DATA"); break;
2259         default: fprintf(stderr, "wtf?!"); break;
2260       }
2261       fputc('\n', stderr);
2262     }
2263     fprintf(stderr, "  BACKLEN: %u (nfa at 0x%08x)\n", ufoImgGetU8(cfa - 1u), UFO_CFA_TO_NFA(cfa));
2264     fprintf(stderr, "  NAME(%u): ", nlen);
2265     for (uint32_t f = 0; f < nlen; f += 1) {
2266       const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2267       if (ch <= 32 || ch >= 127) {
2268         fprintf(stderr, "\\x%02x", ch);
2269       } else {
2270         fprintf(stderr, "%c", (char)ch);
2271       }
2272     }
2273     fprintf(stderr, "\n");
2274     ufo_assert(UFO_CFA_TO_LFA(cfa) == lfa);
2275   }
2276 }
2277
2278
2279 //==========================================================================
2280 //
2281 //  ufoVocCheckName
2282 //
2283 //  return 0 or CFA
2284 //
2285 //==========================================================================
2286 static uint32_t ufoVocCheckName (uint32_t lfa, const void *wname, uint32_t wnlen, uint32_t hash,
2287                                  int allowvochid)
2288 {
2289   uint32_t res = 0;
2290   #ifdef UFO_DEBUG_FIND_WORD
2291   fprintf(stderr, "CHECK-NAME: %.*s; LFA: 0x%08x; hash: 0x%08x (wname: 0x%08x)\n",
2292           (unsigned) wnlen, (const char *)wname,
2293           lfa, (lfa != 0 ? ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)) : 0), hash);
2294   ufoDumpWordHeader(lfa);
2295   #endif
2296   if (lfa != 0 && ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)) == hash) {
2297     const uint32_t lenflags = ufoImgGetU32(UFO_LFA_TO_NFA(lfa));
2298     if ((lenflags & UFW_FLAG_SMUDGE) == 0 &&
2299         (allowvochid || (lenflags & UFW_FLAG_HIDDEN) == 0))
2300     {
2301       const uint32_t nlen = lenflags&0xffU;
2302       if (nlen == wnlen) {
2303         uint32_t naddr = UFO_LFA_TO_NFA(lfa) + 4u;
2304         uint32_t pos = 0;
2305         while (pos < nlen) {
2306           uint8_t c0 = ((const unsigned char *)wname)[pos];
2307           if (c0 >= 'a' && c0 <= 'z') c0 = c0 - 'a' + 'A';
2308           uint8_t c1 = ufoImgGetU8(naddr + pos);
2309           if (c1 >= 'a' && c1 <= 'z') c1 = c1 - 'a' + 'A';
2310           if (c0 != c1) break;
2311           pos += 1u;
2312         }
2313         if (pos == nlen) {
2314           // i found her!
2315           naddr += pos + 1u;
2316           res = UFO_ALIGN4(naddr);
2317         }
2318       }
2319     }
2320   }
2321   return res;
2322 }
2323
2324
2325 //==========================================================================
2326 //
2327 //  ufoFindWordInVoc
2328 //
2329 //  return 0 or CFA
2330 //
2331 //==========================================================================
2332 static uint32_t ufoFindWordInVoc (const void *wname, uint32_t wnlen, uint32_t hash,
2333                                   uint32_t vocid, int allowvochid)
2334 {
2335   uint32_t res = 0;
2336   if (wname == NULL) ufo_assert(wnlen == 0);
2337   if (wnlen != 0 && vocid != 0) {
2338     if (hash == 0) hash = joaatHashBufCI(wname, wnlen);
2339     #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
2340     fprintf(stderr, "IN-VOC: %.*s; VOCID: 0x%08x; whash: 0x%08x; htbl[0]: 0x%08x\n",
2341             (unsigned) wnlen, (const char *)wname,
2342             vocid, hash, ufoImgGetU32(vocid + UFW_VOCAB_OFS_HTABLE));
2343     #endif
2344     const uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
2345     if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
2346       // hash table present, use it
2347       uint32_t bfa = htbl + (hash % (uint32_t)UFO_HASHTABLE_SIZE) * 4u;
2348       bfa = ufoImgGetU32(bfa);
2349       while (res == 0 && bfa != 0) {
2350         #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
2351         fprintf(stderr, "IN-VOC:   bfa: 0x%08x\n", bfa);
2352         #endif
2353         res = ufoVocCheckName(UFO_BFA_TO_LFA(bfa), wname, wnlen, hash, allowvochid);
2354         bfa = ufoImgGetU32(bfa);
2355       }
2356     } else {
2357       // no hash table, use linear search
2358       uint32_t lfa = vocid + UFW_VOCAB_OFS_LATEST;
2359       lfa = ufoImgGetU32(lfa);
2360       while (res == 0 && lfa != 0) {
2361         res = ufoVocCheckName(lfa, wname, wnlen, hash, allowvochid);
2362         lfa = ufoImgGetU32(lfa);
2363       }
2364     }
2365   }
2366   return res;
2367 }
2368
2369
2370 //==========================================================================
2371 //
2372 //  ufoFindColon
2373 //
2374 //  return part after the colon, or `NULL`
2375 //
2376 //==========================================================================
2377 static const void *ufoFindColon (const void *wname, uint32_t wnlen) {
2378   const void *res = NULL;
2379   if (wnlen != 0) {
2380     ufo_assert(wname != NULL);
2381     const char *str = (const char *)wname;
2382     while (wnlen != 0 && str[0] != ':') {
2383       str += 1; wnlen -= 1;
2384     }
2385     if (wnlen != 0) {
2386       res = (const void *)(str + 1); // skip colon
2387     }
2388   }
2389   return res;
2390 }
2391
2392
2393 //==========================================================================
2394 //
2395 //  ufoFindWordInVocAndParents
2396 //
2397 //==========================================================================
2398 static uint32_t ufoFindWordInVocAndParents (const void *wname, uint32_t wnlen, uint32_t hash,
2399                                             uint32_t vocid, int allowvochid)
2400 {
2401   uint32_t res = 0;
2402   if (hash == 0) hash = joaatHashBufCI(wname, wnlen);
2403   while (res == 0 && vocid != 0) {
2404     res = ufoFindWordInVoc(wname, wnlen, hash, vocid, allowvochid);
2405     vocid = ufoImgGetU32(vocid + UFW_VOCAB_OFS_PARENT);
2406   }
2407   return res;
2408 }
2409
2410
2411 //==========================================================================
2412 //
2413 //  ufoFindWordNameRes
2414 //
2415 //  find with name resolution
2416 //
2417 //  return 0 or CFA
2418 //
2419 //==========================================================================
2420 static uint32_t ufoFindWordNameRes (const void *wname, uint32_t wnlen) {
2421   uint32_t res = 0;
2422   if (wnlen != 0 && *(const char *)wname != ':') {
2423     ufo_assert(wname != NULL);
2424
2425     const void *stx = wname;
2426     wname = ufoFindColon(wname, wnlen);
2427     if (wname != NULL) {
2428       // look in all vocabs (excluding hidden ones)
2429       uint32_t xlen = (uint32_t)(ptrdiff_t)(wname - stx) - 1u;
2430       ufo_assert(xlen > 0 && xlen < 255);
2431       uint32_t xhash = joaatHashBufCI(stx, xlen);
2432       uint32_t voclink = ufoImgGetU32(ufoAddrVocLink);
2433       #ifdef UFO_DEBUG_FIND_WORD_COLON
2434       fprintf(stderr, "COLON-FIND: first voc: {%.*s}; xhash=0x%08x; voc-link: 0x%08x\n",
2435               (unsigned)xlen, (const char *)stx, xhash, voclink);
2436       #endif
2437       while (res == 0 && voclink != 0) {
2438         const uint32_t vhdraddr = voclink - UFW_VOCAB_OFS_VOCLINK + UFW_VOCAB_OFS_HEADER;
2439         const uint32_t vhdr = ufoImgGetU32(vhdraddr);
2440         if (vhdr != 0) {
2441           res = ufoVocCheckName(UFO_NFA_TO_LFA(vhdr), stx, xlen, xhash, 0);
2442         }
2443         if (res == 0) voclink = ufoImgGetU32(voclink);
2444       }
2445       if (res != 0) {
2446         uint32_t vocid = voclink - UFW_VOCAB_OFS_VOCLINK;
2447         ufo_assert(voclink != 0);
2448         wnlen -= xlen + 1;
2449         #ifdef UFO_DEBUG_FIND_WORD_COLON
2450         fprintf(stderr, "searching {%.*s}(%u) in {%.*s}\n",
2451                 (unsigned)wnlen, wname, wnlen, (unsigned)xlen, stx);
2452         #endif
2453         while (res != 0 && wname != NULL) {
2454           // first, the whole rest
2455           res = ufoFindWordInVocAndParents(wname, wnlen, 0, vocid, 1);
2456           if (res != 0) {
2457             wname = NULL;
2458           } else {
2459             stx = wname;
2460             wname = ufoFindColon(wname, wnlen);
2461             if (wname == NULL) xlen = wnlen; else xlen = (uint32_t)(ptrdiff_t)(wname - stx) - 1u;
2462             ufo_assert(xlen > 0 && xlen < 255);
2463             res = ufoFindWordInVocAndParents(stx, xlen, 0, vocid, 1);
2464             if (res != 0) {
2465               wnlen -= xlen + 1;
2466               if (wname != NULL) {
2467                 // it should be a vocabulary
2468                 const uint32_t nfa = UFO_CFA_TO_NFA(res);
2469                 if ((ufoImgGetU32(nfa) & UFW_FLAG_VOCAB) != 0) {
2470                   vocid = ufoImgGetU32(UFO_CFA_TO_PFA(res)); // pfa points to vocabulary
2471                 } else {
2472                   res = 0;
2473                 }
2474               }
2475             }
2476           }
2477         }
2478       }
2479     }
2480   }
2481
2482   return res;
2483 }
2484
2485
2486 //==========================================================================
2487 //
2488 //  ufoFindWord
2489 //
2490 //  doesn't look in CURRENT, does name resolution ("a:b" is word "b" in "a")
2491 //
2492 //  return 0 or CFA
2493 //
2494 //==========================================================================
2495 static uint32_t ufoFindWord (const char *wname) {
2496   uint32_t res = 0;
2497   if (wname && wname[0] != 0) {
2498     const size_t wnlen = strlen(wname);
2499     ufo_assert(wnlen < 8192);
2500     uint32_t ctx = ufoImgGetU32(ufoAddrContext);
2501     const uint32_t hash = joaatHashBufCI(wname, (uint32_t)wnlen);
2502
2503     //fprintf(stderr, "FIND-WORD: whash: 0x%08x; name:{%s}\n", hash, wname);
2504
2505     // first search in context
2506     res = ufoFindWordInVocAndParents(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
2507
2508     // now try vocabulary stack
2509     uint32_t vstp = ufoVSP;
2510     while (res == 0 && vstp != 0) {
2511       vstp -= 1;
2512       ctx = ufoVocStack[vstp];
2513       res = ufoFindWordInVocAndParents(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
2514     }
2515
2516     // if not found, try name resolution
2517     if (res == 0) res = ufoFindWordNameRes(wname, (uint32_t)wnlen);
2518   }
2519
2520   return res;
2521 }
2522
2523
2524 //==========================================================================
2525 //
2526 //  ufoCreateWordHeader
2527 //
2528 //  create word header up to CFA, link to the current dictionary
2529 //
2530 //==========================================================================
2531 static void ufoCreateWordHeader (const char *wname, uint32_t flags) {
2532   if (wname == NULL) wname = "";
2533   const size_t wnlen = strlen(wname);
2534   ufo_assert(wnlen < UFO_MAX_WORD_LENGTH);
2535   const uint32_t hash = joaatHashBufCI(wname, (uint32_t)wnlen);
2536   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
2537   ufo_assert(curr != 0);
2538   // redefine check
2539   const uint32_t warn = ufoImgGetU32(ufoAddrRedefineWarning);
2540   if (wnlen != 0 && warn != UFO_REDEF_WARN_DONT_CARE) {
2541     uint32_t cfa;
2542     if (warn != UFO_REDEF_WARN_PARENTS) {
2543       cfa = ufoFindWordInVoc(wname, wnlen, hash, curr, 1);
2544     } else {
2545       cfa = ufoFindWordInVocAndParents(wname, wnlen, hash, curr, 1);
2546     }
2547     if (cfa != 0) {
2548       const uint32_t nfa = UFO_CFA_TO_NFA(cfa);
2549       const uint32_t flags = ufoImgGetU32(nfa);
2550       if ((flags & UFW_FLAG_PROTECTED) != 0) {
2551         ufoFatal("trying to redefine protected word '%s'", wname);
2552       } else if (warn != UFO_REDEF_WARN_NONE) {
2553         ufoWarning("redefining word '%s'", wname);
2554       }
2555     }
2556   }
2557   //fprintf(stderr, "000: HERE: 0x%08x\n", UFO_GET_DP());
2558   const uint32_t bkt = (hash % (uint32_t)UFO_HASHTABLE_SIZE) * 4u;
2559   const uint32_t htbl = curr + UFW_VOCAB_OFS_HTABLE;
2560   ufoImgEmitAlign();
2561   const uint32_t xfaAddr = UFO_GET_DP();
2562   if ((xfaAddr & UFO_ADDR_TEMP_BIT) == 0) {
2563     // link previous yfa here
2564     const uint32_t lastxfa = ufoImgGetU32(ufoAddrLastXFA);
2565     // fix YFA of the previous word
2566     if (lastxfa != 0) {
2567       ufoImgPutU32(UFO_XFA_TO_YFA(lastxfa), UFO_XFA_TO_YFA(xfaAddr));
2568     }
2569     // our XFA points to the previous XFA
2570     ufoImgEmitU32(lastxfa); // xfa
2571     // update last XFA
2572     ufoImgPutU32(ufoAddrLastXFA, xfaAddr);
2573   } else {
2574     ufoImgEmitU32(0); // xfa
2575   }
2576   ufoImgEmitU32(0); // yfa
2577   // bucket link (bfa)
2578   if (wnlen == 0 || ufoImgGetU32(htbl) == UFO_NO_HTABLE_FLAG) {
2579     ufoImgEmitU32(0);
2580   } else {
2581     #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
2582     fprintf(stderr, "NEW HEADER: %s; curr: 0x%08x; htbl: 0x%08x; bkt: 0x%08x\n",
2583             wname, curr, htbl, bkt);
2584     fprintf(stderr, "  [bkt]: 0x%08x; nbk: 0x%08x\n", ufoImgGetU32(htbl + bkt), UFO_GET_DP());
2585     #endif
2586     // bfa points to bfa
2587     const uint32_t bfa = UFO_GET_DP();
2588     ufoImgEmitU32(ufoImgGetU32(htbl + bkt));
2589     ufoImgPutU32(htbl + bkt, bfa);
2590   }
2591   // lfa
2592   const uint32_t lfa = UFO_GET_DP();
2593   ufoImgEmitU32(ufoImgGetU32(curr + UFW_VOCAB_OFS_LATEST));
2594   // fix voc latest
2595   ufoImgPutU32(curr + UFW_VOCAB_OFS_LATEST, lfa);
2596   // name hash
2597   ufoImgEmitU32(hash);
2598   // name length
2599   const uint32_t nfa = UFO_GET_DP();
2600   ufoImgEmitU32(((uint32_t)wnlen&0xffU) | (flags & 0xffffff00U));
2601   const uint32_t nstart = UFO_GET_DP();
2602   // put name
2603   for (size_t f = 0; f < wnlen; f += 1) {
2604     ufoImgEmitU8(((const unsigned char *)wname)[f]);
2605   }
2606   while ((UFO_GET_DP() & 3) != 3) ufoImgEmitU8(0);
2607   const uint32_t nend = UFO_GET_DP(); // length byte itself is not included
2608   // name length, again
2609   ufo_assert(nend - nstart <= 255);
2610   ufoImgEmitU8((uint8_t)(nend - nstart));
2611   ufo_assert((UFO_GET_DP() & 3) == 0);
2612   ufo_assert(UFO_CFA_TO_NFA(UFO_GET_DP()) == nfa);
2613   if ((nend & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(nend);
2614   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
2615   fprintf(stderr, "*** NEW HEADER ***\n");
2616   fprintf(stderr, "CFA: 0x%08x\n", UFO_GET_DP());
2617   fprintf(stderr, "NSTART: 0x%08x\n", nstart);
2618   fprintf(stderr, "NEND: 0x%08x\n", nend);
2619   fprintf(stderr, "NLEN: %u (%u)\n", nend - nstart, ufoImgGetU8(UFO_GET_DP() - 1u));
2620   ufoDumpWordHeader(lfa);
2621   #endif
2622   #if 0
2623   fprintf(stderr, "NEW WORD CFA 0x%08x: %s\n", UFO_GET_DP(), wname);
2624   #endif
2625 }
2626
2627
2628 //==========================================================================
2629 //
2630 //  ufoDecompilePart
2631 //
2632 //==========================================================================
2633 static void ufoDecompilePart (uint32_t addr, uint32_t eaddr, int indent) {
2634   uint32_t count;
2635   FILE *fo = stdout;
2636   while (addr < eaddr) {
2637     uint32_t cfa = ufoImgGetU32(addr);
2638     for (int n = 0; n < indent; n += 1) fputc(' ', fo);
2639     fprintf(fo, "%6u: 0x%08x: ", addr, cfa);
2640     uint32_t nfa = UFO_CFA_TO_NFA(cfa);
2641     uint32_t flags = ufoImgGetU32(nfa);
2642     //fprintf(fo, "[0x%08x] ", flags & UFW_WARG_MASK);
2643     uint32_t nlen = flags & 0xffU;
2644     for (uint32_t f = 0; f < nlen; f += 1) {
2645       const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2646       if (ch <= 32 || ch >= 127) {
2647         fprintf(fo, "\\x%02x", ch);
2648       } else {
2649         fprintf(fo, "%c", (char)ch);
2650       }
2651     }
2652     addr += 4u;
2653     switch (flags & UFW_WARG_MASK) {
2654       case UFW_WARG_NONE:
2655         break;
2656       case UFW_WARG_BRANCH:
2657         fprintf(fo, "  @%u", ufoImgGetU32(addr)); addr += 4u;
2658         break;
2659       case UFW_WARG_LIT:
2660         fprintf(fo, "  %u : %d : 0x%08x", ufoImgGetU32(addr),
2661                 (int32_t)ufoImgGetU32(addr), ufoImgGetU32(addr)); addr += 4u;
2662         break;
2663       case UFW_WARG_C4STRZ:
2664         count = ufoImgGetU32(addr); addr += 4;
2665        print_str:
2666         fprintf(fo, "  str:");
2667         for (int f = 0; f < count; f += 1) {
2668           const uint8_t ch = ufoImgGetU8(addr); addr += 1u;
2669           if (ch <= 32 || ch >= 127) {
2670             fprintf(fo, "\\x%02x", ch);
2671           } else {
2672             fprintf(fo, "%c", (char)ch);
2673           }
2674         }
2675         addr += 1u; // skip zero byte
2676         addr = UFO_ALIGN4(addr);
2677         break;
2678       case UFW_WARG_CFA:
2679         cfa = ufoImgGetU32(addr); addr += 4u;
2680         fprintf(fo, "  CFA:%u: ", cfa);
2681         nfa = UFO_CFA_TO_NFA(cfa);
2682         nlen = ufoImgGetU8(nfa);
2683         for (uint32_t f = 0; f < nlen; f += 1) {
2684           const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2685           if (ch <= 32 || ch >= 127) {
2686             fprintf(fo, "\\x%02x", ch);
2687           } else {
2688             fprintf(fo, "%c", (char)ch);
2689           }
2690         }
2691         break;
2692       case UFW_WARG_CBLOCK:
2693         fprintf(fo, "  CBLOCK:%u", ufoImgGetU32(addr)); addr += 4u;
2694         break;
2695       case UFW_WARG_VOCID:
2696         fprintf(fo, "  VOCID:%u", ufoImgGetU32(addr)); addr += 4u;
2697         break;
2698       case UFW_WARG_C1STRZ:
2699         count = ufoImgGetU8(addr); addr += 1;
2700         goto print_str;
2701       case UFW_WARG_DATASKIP:
2702         fprintf(fo, "  DATA:%u", ufoImgGetU32(addr));
2703         addr += ufoImgGetU32(addr) + 4u;
2704         break;
2705       default:
2706         fprintf(fo, " -- WTF?!\n");
2707         abort();
2708     }
2709     fputc('\n', fo);
2710   }
2711 }
2712
2713
2714 //==========================================================================
2715 //
2716 //  ufoDecompileWord
2717 //
2718 //==========================================================================
2719 static void ufoDecompileWord (const uint32_t cfa) {
2720   if (cfa != 0) {
2721     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
2722     fprintf(stdout, "#### DECOMPILING CFA %u ###\n", cfa);
2723     ufoDumpWordHeader(lfa);
2724     const uint32_t yfa = ufoGetWordEndAddr(cfa);
2725     if (ufoImgGetU32(cfa) == ufoDoForthCFA) {
2726       fprintf(stdout, "--- DECOMPILED CODE ---\n");
2727       ufoDecompilePart(UFO_CFA_TO_PFA(cfa), yfa, 0);
2728       fprintf(stdout, "=======================\n");
2729     }
2730   }
2731 }
2732
2733
2734 //==========================================================================
2735 //
2736 //  ufoBTShowWordName
2737 //
2738 //==========================================================================
2739 static void ufoBTShowWordName (uint32_t nfa) {
2740   if (nfa != 0) {
2741     uint32_t len = ufoImgGetU8(nfa); nfa += 4u;
2742     //fprintf(stderr, "(0x%08x)", ufoImgGetU32(nfa - 4u));
2743     while (len != 0) {
2744       uint8_t ch = ufoImgGetU8(nfa); nfa += 1u; len -= 1u;
2745       if (ch <= 32 || ch >= 127) {
2746         fprintf(stderr, "\\x%02x", ch);
2747       } else {
2748         fprintf(stderr, "%c", (char)ch);
2749       }
2750     }
2751   }
2752 }
2753
2754
2755 //==========================================================================
2756 //
2757 //  ufoBacktrace
2758 //
2759 //==========================================================================
2760 static void ufoBacktrace (uint32_t ip, int showDataStack) {
2761   // dump data stack (top 16)
2762   ufoFlushOutput();
2763   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
2764
2765   if (showDataStack) {
2766     fprintf(stderr, "***UFO STACK DEPTH: %u\n", ufoSP);
2767     uint32_t xsp = ufoSP;
2768     if (xsp > 16) xsp = 16;
2769     for (uint32_t sp = 0; sp < xsp; ++sp) {
2770       fprintf(stderr, "  %2u: 0x%08x  %d%s\n",
2771               sp, ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1],
2772               (sp == 0 ? " -- TOS" : ""));
2773     }
2774     if (ufoSP > 16) fprintf(stderr, "    ...more...\n");
2775   }
2776
2777   // dump return stack (top 32)
2778   uint32_t nfa;
2779   uint32_t fline;
2780   const char *fname;
2781
2782   fprintf(stderr, "***UFO RETURN STACK DEPTH: %u\n", ufoRP);
2783   if (ip != 0) {
2784     nfa = ufoFindWordForIP(ip);
2785     if (nfa != 0) {
2786       fprintf(stderr, "  **: %8u -- ", ip);
2787       ufoBTShowWordName(nfa);
2788       fname = ufoFindFileForIP(ip, &fline, NULL, NULL);
2789       if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }
2790       fputc('\n', stderr);
2791     }
2792   }
2793   uint32_t rp = ufoRP;
2794   uint32_t rscount = 0;
2795   if (rp > UFO_RSTACK_SIZE) rp = UFO_RSTACK_SIZE;
2796   while (rscount != 32 && rp != 0) {
2797     rp -= 1;
2798     const uint32_t val = ufoRStack[rp];
2799     nfa = ufoFindWordForIP(val);
2800     if (nfa != 0) {
2801       fprintf(stderr, "  %2u: %8u -- ", ufoRP - rp - 1u, val);
2802       ufoBTShowWordName(nfa);
2803       fname = ufoFindFileForIP(val - 4u, &fline, NULL, NULL);
2804       if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }
2805       fputc('\n', stderr);
2806     } else {
2807       fprintf(stderr, "  %2u: 0x%08x  %d\n", ufoRP - rp - 1u, val, (int32_t)val);
2808     }
2809     rscount += 1;
2810   }
2811   if (ufoRP > 32) fprintf(stderr, "    ...more...\n");
2812
2813   ufoFlushOutput();
2814 }
2815
2816
2817 //==========================================================================
2818 //
2819 //  ufoDumpVocab
2820 //
2821 //==========================================================================
2822 /*
2823 static void ufoDumpVocab (uint32_t vocid) {
2824   if (vocid != 0) {
2825     fprintf(stderr, "*** VOCID: 0x%08x ***\n", vocid);
2826     uint32_t vochdr = vocid + UFW_VOCAB_OFS_HEADER;
2827     vochdr = ufoImgGetU32(vochdr);
2828     if (vochdr != 0) {
2829       fprintf(stderr, "--- HEADER ---\n");
2830       ufoDumpWordHeader(UFO_NFA_TO_LFA(vochdr));
2831       fprintf(stderr, "========\n");
2832       uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
2833       if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
2834         fprintf(stderr, "--- HASH TABLE ---\n");
2835         for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) {
2836           uint32_t bfa = ufoImgGetU32(htbl);
2837           if (bfa != 0) {
2838             fprintf(stderr, "**** %2d: 0x%08x\n", f, bfa);
2839             do {
2840               ufoDumpWordHeader(UFO_BFA_TO_LFA(bfa));
2841               bfa = ufoImgGetU32(bfa);
2842             } while (bfa != 0);
2843           }
2844           htbl += 4u;
2845         }
2846       }
2847     }
2848   }
2849 }
2850 */
2851
2852
2853 // if set, this will be used when we are out of include files. intended for UrAsm.
2854 // return 0 if there is no more lines, otherwise the string should be copied
2855 // to buffer, `*fname` and `*fline` should be properly set.
2856 int (*ufoFileReadLine) (void *buf, size_t bufsize, const char **fname, int *fline) = NULL;
2857
2858
2859 //==========================================================================
2860 //
2861 //  ufoLoadNextUserLine
2862 //
2863 //==========================================================================
2864 static int ufoLoadNextUserLine (void) {
2865   uint32_t tibPos = 0;
2866   const char *fname = NULL;
2867   int fline = 0;
2868   ufoResetTib();
2869   if (ufoFileReadLine != NULL && ufoFileReadLine(ufoCurrFileLine, 510, &fname, &fline) != 0) {
2870     ufoCurrFileLine[510] = 0;
2871     uint32_t slen = (uint32_t)strlen(ufoCurrFileLine);
2872     while (slen != 0 && (ufoCurrFileLine[slen - 1u] == 10 || ufoCurrFileLine[slen - 1u] == 13)) {
2873       slen -= 1u;
2874     }
2875     if (tibPos + slen + 1u > UFO_ADDR_HANDLE_OFS_MASK) {
2876       ufoFatal("input text line too long (at least %u bytes)", tibPos + slen);
2877     }
2878     ufoTibEnsureSize(tibPos + slen + 1u);
2879     for (uint32_t f = 0; f < slen; f += 1) {
2880       ufoTibPokeChOfs(((const unsigned char *)ufoCurrFileLine)[f], tibPos + f);
2881     }
2882     ufoTibPokeChOfs(0, tibPos + slen);
2883     tibPos += slen;
2884     if (fname == NULL) fname = "<user>";
2885     ufoSetInFileName(fname);
2886     ufoInFileLine = fline;
2887     return 1;
2888   } else {
2889     return 0;
2890   }
2891 }
2892
2893
2894 //==========================================================================
2895 //
2896 //  ufoLoadNextLine_NativeMode
2897 //
2898 //  load next file line into TIB
2899 //  always strips final '\n'
2900 //
2901 //  return 0 on EOF, 1 on success
2902 //
2903 //==========================================================================
2904 static int ufoLoadNextLine (int crossInclude) {
2905   int done = 0;
2906   uint32_t tibPos = 0;
2907   ufoResetTib();
2908
2909   if (ufoMode == UFO_MODE_MACRO) {
2910     //fprintf(stderr, "***MAC!\n");
2911     return 0;
2912   }
2913
2914   while (ufoInFile != NULL && !done) {
2915     if (fgets(ufoCurrFileLine, 510, ufoInFile) != NULL) {
2916       // check for a newline
2917       // if there is no newline char at the end, the string was truncated
2918       ufoCurrFileLine[510] = 0;
2919       const uint32_t slen = (uint32_t)strlen(ufoCurrFileLine);
2920       if (tibPos + slen + 1u > UFO_ADDR_HANDLE_OFS_MASK) {
2921         ufoFatal("input text line too long (at least %u bytes)", tibPos + slen);
2922       }
2923       ufoTibEnsureSize(tibPos + slen + 1u);
2924       for (uint32_t f = 0; f < slen; f += 1) {
2925         ufoTibPokeChOfs(((const unsigned char *)ufoCurrFileLine)[f], tibPos + f);
2926       }
2927       ufoTibPokeChOfs(0, tibPos + slen);
2928       tibPos += slen;
2929       if (slen != 0 && (ufoCurrFileLine[slen - 1u] == 13 || ufoCurrFileLine[slen - 1u] == 10)) {
2930         ++ufoInFileLine;
2931         done = 1;
2932       } else {
2933         // continuation, nothing to do
2934       }
2935     } else {
2936       // if we read nothing, this is EOF
2937       if (tibPos == 0 && crossInclude) {
2938         // we read nothing, and allowed to cross include boundaries
2939         ufoPopInFile();
2940       } else {
2941         done = 1;
2942       }
2943     }
2944   }
2945
2946   if (tibPos == 0) {
2947     // eof, try user-supplied input
2948     if (ufoFileStackPos == 0) {
2949       return ufoLoadNextUserLine();
2950     } else {
2951       return 0;
2952     }
2953   } else {
2954     // if we read at least something, this is not EOF
2955     return 1;
2956   }
2957 }
2958
2959
2960 // ////////////////////////////////////////////////////////////////////////// //
2961 // debug
2962
2963 // DUMP-STACK
2964 // ( -- )
2965 UFWORD(DUMP_STACK) {
2966   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
2967   printf("***UFO STACK DEPTH: %u\n", ufoSP);
2968   uint32_t xsp = ufoSP;
2969   if (xsp > 16) xsp = 16;
2970   for (uint32_t sp = 0; sp < xsp; ++sp) {
2971     printf("  %2u: 0x%08x  %d%s\n",
2972            sp, ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1],
2973            (sp == 0 ? " -- TOS" : ""));
2974   }
2975   if (ufoSP > 16) printf("    ...more...\n");
2976   ufoLastEmitWasCR = 1;
2977 }
2978
2979 // BACKTRACE
2980 // ( -- )
2981 UFWORD(UFO_BACKTRACE) {
2982   ufoFlushOutput();
2983   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
2984   if (ufoInFile != NULL) {
2985     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
2986   } else {
2987     fprintf(stderr, "*** somewhere in time ***\n");
2988   }
2989   ufoBacktrace(ufoIP, 1);
2990 }
2991
2992 // DUMP-STACK-TASK
2993 // ( stid -- )
2994 UFWORD(DUMP_STACK_TASK) {
2995   UfoState *st = ufoFindState(ufoPop());
2996   if (st == NULL) ufoFatal("invalid state id");
2997   // temporarily switch the task
2998   UfoState *oldst = ufoCurrState; ufoCurrState = st;
2999   // dump
3000   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3001   printf("***UFO STACK DEPTH: %u\n", ufoSP);
3002   uint32_t xsp = ufoSP;
3003   if (xsp > 16) xsp = 16;
3004   for (uint32_t sp = 0; sp < xsp; ++sp) {
3005     printf("  %2u: 0x%08x  %d%s\n",
3006            sp, ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1],
3007            (sp == 0 ? " -- TOS" : ""));
3008   }
3009   if (ufoSP > 16) printf("    ...more...\n");
3010   ufoLastEmitWasCR = 1;
3011   // restore state
3012   ufoCurrState = oldst;
3013 }
3014
3015 // DUMP-RSTACK-TASK
3016 // ( stid -- )
3017 UFWORD(DUMP_RSTACK_TASK) {
3018   UfoState *st = ufoFindState(ufoPop());
3019   if (st == NULL) ufoFatal("invalid state id");
3020   // temporarily switch the task
3021   UfoState *oldst = ufoCurrState; ufoCurrState = st;
3022   // dump
3023   ufoFlushOutput();
3024   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3025   if (ufoInFile != NULL) {
3026     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
3027   } else {
3028     fprintf(stderr, "*** somewhere in time ***\n");
3029   }
3030   ufoBacktrace(ufoIP, 0);
3031   // restore state
3032   ufoCurrState = oldst;
3033 }
3034
3035 // BACKTRACE-TASK
3036 // ( stid -- )
3037 UFWORD(UFO_BACKTRACE_TASK) {
3038   UfoState *st = ufoFindState(ufoPop());
3039   if (st == NULL) ufoFatal("invalid state id");
3040   // temporarily switch the task
3041   UfoState *oldst = ufoCurrState; ufoCurrState = st;
3042   // dump
3043   ufoFlushOutput();
3044   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3045   if (ufoInFile != NULL) {
3046     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
3047   } else {
3048     fprintf(stderr, "*** somewhere in time ***\n");
3049   }
3050   ufoBacktrace(ufoIP, 1);
3051   // restore state
3052   ufoCurrState = oldst;
3053 }
3054
3055
3056 // ////////////////////////////////////////////////////////////////////////// //
3057 // some init words, and PAD
3058 //
3059
3060 // SP0!
3061 // ( -- )
3062 UFWORD(SP0_STORE) { ufoSP = 0; }
3063
3064 // RP0!
3065 // ( -- )
3066 UFWORD(RP0_STORE) {
3067   if (ufoRP != ufoRPTop) {
3068     ufoRP = ufoRPTop;
3069     // we need to push a dummy value
3070     ufoRPush(0xdeadf00d);
3071   }
3072 }
3073
3074 // PAD
3075 // ( -- pad )
3076 // PAD is at the beginning of temp area
3077 UFWORD(PAD) {
3078   ufoPush(UFO_PAD_ADDR);
3079 }
3080
3081
3082 // ////////////////////////////////////////////////////////////////////////// //
3083 // peeks and pokes with address register
3084 //
3085
3086 // A>
3087 // ( -- regA )
3088 UFWORD(REGA_LOAD) {
3089   ufoPush(ufoRegA);
3090 }
3091
3092 // >A
3093 // ( regA -- )
3094 UFWORD(REGA_STORE) {
3095   ufoRegA = ufoPop();
3096 }
3097
3098 // A-SWAP
3099 // ( regA -- oldA )
3100 // swap TOS and A
3101 UFWORD(REGA_SWAP) {
3102   const uint32_t newa = ufoPop();
3103   ufoPush(ufoRegA);
3104   ufoRegA = newa;
3105 }
3106
3107 // +1>A
3108 // ( -- )
3109 UFWORD(REGA_INC) {
3110   ufoRegA += 1u;
3111 }
3112
3113 // +4>A
3114 // ( -- )
3115 UFWORD(REGA_INC_CELL) {
3116   ufoRegA += 4u;
3117 }
3118
3119 // A>R
3120 // ( -- | rega )
3121 UFWORD(REGA_TO_R) {
3122   ufoRPush(ufoRegA);
3123 }
3124
3125 // R>A
3126 // ( | rega -- )
3127 UFWORD(R_TO_REGA) {
3128   ufoRegA = ufoRPop();
3129 }
3130
3131
3132 // ////////////////////////////////////////////////////////////////////////// //
3133 // useful to work with handles and normal addreses uniformly
3134 //
3135
3136 // C@A+
3137 // ( idx -- byte )
3138 UFWORD(CPEEK_REGA_IDX) {
3139   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3140     const uint32_t idx = ufoPop();
3141     const uint32_t newaddr = ufoRegA + idx;
3142     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK)) {
3143       ufoPush(ufoImgGetU8Ext(newaddr));
3144     } else {
3145       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3146                ufoRegA, idx, newaddr);
3147     }
3148   } else {
3149     ufoPush(ufoRegA);
3150     UFCALL(PAR_HANDLE_LOAD_BYTE);
3151   }
3152 }
3153
3154 // W@A+
3155 // ( idx -- word )
3156 UFWORD(WPEEK_REGA_IDX) {
3157   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3158     const uint32_t idx = ufoPop();
3159     const uint32_t newaddr = ufoRegA + idx;
3160     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3161         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 1u) & UFO_ADDR_SPECIAL_BITS_MASK))
3162     {
3163       ufoPush(ufoImgGetU16(newaddr));
3164     } else {
3165       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3166                ufoRegA, idx, newaddr);
3167     }
3168   } else {
3169     ufoPush(ufoRegA);
3170     UFCALL(PAR_HANDLE_LOAD_WORD);
3171   }
3172 }
3173
3174 // @A+
3175 // ( idx -- value )
3176 UFWORD(PEEK_REGA_IDX) {
3177   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3178     const uint32_t idx = ufoPop();
3179     const uint32_t newaddr = ufoRegA + idx;
3180     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3181         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 3u) & UFO_ADDR_SPECIAL_BITS_MASK))
3182     {
3183       ufoPush(ufoImgGetU32(newaddr));
3184     } else {
3185       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3186                ufoRegA, idx, newaddr);
3187     }
3188   } else {
3189     ufoPush(ufoRegA);
3190     UFCALL(PAR_HANDLE_LOAD_CELL);
3191   }
3192 }
3193
3194 // C!A+
3195 // ( byte idx -- )
3196 UFWORD(CPOKE_REGA_IDX) {
3197   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3198     const uint32_t idx = ufoPop();
3199     const uint32_t newaddr = ufoRegA + idx;
3200     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK)) {
3201       const uint32_t value = ufoPop();
3202       ufoImgPutU8(newaddr, value);
3203     } else {
3204       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3205                ufoRegA, idx, newaddr);
3206     }
3207   } else {
3208     ufoPush(ufoRegA);
3209     UFCALL(PAR_HANDLE_STORE_BYTE);
3210   }
3211 }
3212
3213 // W!A+
3214 // ( word idx -- )
3215 UFWORD(WPOKE_REGA_IDX) {
3216   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3217     const uint32_t idx = ufoPop();
3218     const uint32_t newaddr = ufoRegA + idx;
3219     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3220         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 1u) & UFO_ADDR_SPECIAL_BITS_MASK))
3221     {
3222       const uint32_t value = ufoPop();
3223       ufoImgPutU16(newaddr, value);
3224     } else {
3225       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3226                ufoRegA, idx, newaddr);
3227     }
3228   } else {
3229     ufoPush(ufoRegA);
3230     UFCALL(PAR_HANDLE_STORE_WORD);
3231   }
3232 }
3233
3234 // !A+
3235 // ( value idx -- )
3236 UFWORD(POKE_REGA_IDX) {
3237   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3238     const uint32_t idx = ufoPop();
3239     const uint32_t newaddr = ufoRegA + idx;
3240     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3241         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 3u) & UFO_ADDR_SPECIAL_BITS_MASK))
3242     {
3243       const uint32_t value = ufoPop();
3244       ufoImgPutU32(newaddr, value);
3245     } else {
3246       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3247                ufoRegA, idx, newaddr);
3248     }
3249   } else {
3250     ufoPush(ufoRegA);
3251     UFCALL(PAR_HANDLE_STORE_CELL);
3252   }
3253 }
3254
3255
3256 // ////////////////////////////////////////////////////////////////////////// //
3257 // peeks and pokes
3258 //
3259
3260 // C@
3261 // ( addr -- value8 )
3262 UFWORD(CPEEK) {
3263   ufoPush(ufoImgGetU8Ext(ufoPop()));
3264 }
3265
3266 // W@
3267 // ( addr -- value16 )
3268 UFWORD(WPEEK) {
3269   const uint32_t addr = ufoPop();
3270   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
3271     ufoPush(ufoImgGetU16(addr));
3272   } else {
3273     ufoPush(0);
3274     ufoPush(addr);
3275     UFCALL(PAR_HANDLE_LOAD_WORD);
3276   }
3277 }
3278
3279 // @
3280 // ( addr -- value32 )
3281 UFWORD(PEEK) {
3282   const uint32_t addr = ufoPop();
3283   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
3284     ufoPush(ufoImgGetU32(addr));
3285   } else {
3286     ufoPush(0);
3287     ufoPush(addr);
3288     UFCALL(PAR_HANDLE_LOAD_CELL);
3289   }
3290 }
3291
3292 // C!
3293 // ( val8 addr -- )
3294 UFWORD(CPOKE) {
3295   const uint32_t addr = ufoPop();
3296   const uint32_t val = ufoPop();
3297   ufoImgPutU8Ext(addr, val);
3298 }
3299
3300 // W!
3301 // ( val16 addr -- )
3302 UFWORD(WPOKE) {
3303   const uint32_t addr = ufoPop();
3304   const uint32_t val = ufoPop();
3305   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
3306     ufoImgPutU16(addr, val);
3307   } else {
3308     ufoPush(val);
3309     ufoPush(0);
3310     ufoPush(addr);
3311     UFCALL(PAR_HANDLE_STORE_WORD);
3312   }
3313 }
3314
3315 // !
3316 // ( val32 addr -- )
3317 UFWORD(POKE) {
3318   const uint32_t addr = ufoPop();
3319   const uint32_t val = ufoPop();
3320   if ((addr & UFO_ADDR_HANDLE_BIT) == 0) {
3321     ufoImgPutU32(addr, val);
3322   } else {
3323     ufoPush(val);
3324     ufoPush(0);
3325     ufoPush(addr);
3326     UFCALL(PAR_HANDLE_STORE_CELL);
3327   }
3328 }
3329
3330
3331 // ////////////////////////////////////////////////////////////////////////// //
3332 // dictionary emitters
3333 //
3334
3335 // C,
3336 // ( val8 -- )
3337 UFWORD(CCOMMA) { const uint32_t val = ufoPop(); ufoImgEmitU8(val); }
3338
3339 // W,
3340 // ( val16 -- )
3341 UFWORD(WCOMMA) { const uint32_t val = ufoPop(); ufoImgEmitU8(val&0xffU); ufoImgEmitU8((val >> 8)&0xffU); }
3342
3343 // ,
3344 // ( val -- )
3345 UFWORD(COMMA) { const uint32_t val = ufoPop(); ufoImgEmitU32(val); }
3346
3347
3348 // ////////////////////////////////////////////////////////////////////////// //
3349 // literal pushers
3350 //
3351
3352 // (LIT) ( -- n )
3353 UFWORD(PAR_LIT) {
3354   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
3355   ufoPush(v);
3356 }
3357
3358 // (LITCFA) ( -- n )
3359 UFWORD(PAR_LITCFA) {
3360   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
3361   ufoPush(v);
3362 }
3363
3364 // (LITVOCID) ( -- n )
3365 UFWORD(PAR_LITVOCID) {
3366   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
3367   ufoPush(v);
3368 }
3369
3370 // (LITSTR8)
3371 UFWORD(PAR_LITSTR8) {
3372   const uint32_t count = ufoImgGetU8(ufoIP); ufoIP += 1;
3373   ufoPush(ufoIP);
3374   ufoPush(count);
3375   ufoIP += count + 1; // 1 for terminating 0
3376   // align
3377   ufoIP = UFO_ALIGN4(ufoIP);
3378 }
3379
3380
3381 // ////////////////////////////////////////////////////////////////////////// //
3382 // jumps, etc.
3383 //
3384
3385 // (BRANCH) ( -- )
3386 UFWORD(PAR_BRANCH) {
3387   ufoIP = ufoImgGetU32(ufoIP);
3388 }
3389
3390 // (TBRANCH) ( flag )
3391 UFWORD(PAR_TBRANCH) {
3392   if (ufoPop()) {
3393     ufoIP = ufoImgGetU32(ufoIP);
3394   } else {
3395     ufoIP += 4;
3396   }
3397 }
3398
3399 // (0BRANCH) ( flag )
3400 UFWORD(PAR_0BRANCH) {
3401   if (!ufoPop()) {
3402     ufoIP = ufoImgGetU32(ufoIP);
3403   } else {
3404     ufoIP += 4;
3405   }
3406 }
3407
3408 // (+0BRANCH) ( flag )
3409 UFWORD(PAR_P0BRANCH) {
3410   if ((ufoPop() & 0x80000000u) == 0) {
3411     ufoIP = ufoImgGetU32(ufoIP);
3412   } else {
3413     ufoIP += 4;
3414   }
3415 }
3416
3417 // (+BRANCH) ( flag )
3418 UFWORD(PAR_PBRANCH) {
3419   const uint32_t v = ufoPop();
3420   if (v > 0 && v < 0x80000000u) {
3421     ufoIP = ufoImgGetU32(ufoIP);
3422   } else {
3423     ufoIP += 4;
3424   }
3425 }
3426
3427 // (-0BRANCH) ( flag )
3428 UFWORD(PAR_M0BRANCH) {
3429   const uint32_t v = ufoPop();
3430   if (v == 0 || v >= 0x80000000u) {
3431     ufoIP = ufoImgGetU32(ufoIP);
3432   } else {
3433     ufoIP += 4;
3434   }
3435 }
3436
3437 // (-BRANCH) ( flag )
3438 UFWORD(PAR_MBRANCH) {
3439   if ((ufoPop() & 0x80000000u) != 0) {
3440     ufoIP = ufoImgGetU32(ufoIP);
3441   } else {
3442     ufoIP += 4;
3443   }
3444 }
3445
3446 // (DATASKIP) ( -- )
3447 UFWORD(PAR_DATASKIP) {
3448   ufoIP += ufoImgGetU32(ufoIP) + 4u;
3449 }
3450
3451
3452 // ////////////////////////////////////////////////////////////////////////// //
3453 // execute words by CFA
3454 //
3455
3456 // EXECUTE ( cfa )
3457 UFWORD(EXECUTE) {
3458   ufoRPush(ufoPop());
3459   ufoVMRPopCFA = 1;
3460 }
3461
3462 // EXECUTE-TAIL ( cfa )
3463 UFWORD(EXECUTE_TAIL) {
3464   ufoIP = ufoRPop();
3465   ufoRPush(ufoPop());
3466   ufoVMRPopCFA = 1;
3467 }
3468
3469
3470 // ////////////////////////////////////////////////////////////////////////// //
3471 // word termination, locals support
3472 //
3473
3474 // (EXIT)
3475 UFWORD(PAR_EXIT) {
3476   ufoIP = ufoRPop();
3477 }
3478
3479 // (L-ENTER)
3480 // ( loccount -- )
3481 UFWORD(PAR_LENTER) {
3482   // low byte of loccount is total number of locals
3483   // high byte is the number of args
3484   uint32_t lcount = ufoImgGetU32(ufoIP); ufoIP += 4u;
3485   uint32_t acount = (lcount >> 8) & 0xff;
3486   lcount &= 0xff;
3487   if (lcount == 0 || lcount < acount) ufoFatal("invalid call to (L-ENTER)");
3488   if ((ufoLBP != 0 && ufoLBP >= ufoLP) || UFO_LSTACK_SIZE - ufoLP <= lcount + 2) {
3489     ufoFatal("out of locals stack");
3490   }
3491   uint32_t newbp;
3492   if (ufoLP == 0) { ufoLP = 1; newbp = 1; } else newbp = ufoLP;
3493   //fprintf(stderr, "LP: %u; LBP: %u; locs: %u; word: %s\n", ufoLP, ufoLBP, fw->locs, fw->name);
3494   ufoLStack[ufoLP] = ufoLBP; ufoLP += 1;
3495   ufoLBP = newbp; ufoLP += lcount;
3496   // and copy args
3497   newbp += acount;
3498   while (newbp != ufoLBP) {
3499     ufoLStack[newbp] = ufoPop();
3500     newbp -= 1;
3501   }
3502 }
3503
3504 // (L-LEAVE)
3505 UFWORD(PAR_LLEAVE) {
3506   if (ufoLBP == 0) ufoFatal("(L-LEAVE) with empty locals stack");
3507   if (ufoLBP >= ufoLP) ufoFatal("(L-LEAVE) broken locals stack");
3508   ufoLP = ufoLBP;
3509   ufoLBP = ufoLStack[ufoLBP];
3510 }
3511
3512 //==========================================================================
3513 //
3514 //  ufoLoadLocal
3515 //
3516 //==========================================================================
3517 UFO_FORCE_INLINE void ufoLoadLocal (const uint32_t lidx) {
3518   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index");
3519   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
3520   ufoPush(ufoLStack[ufoLBP + lidx]);
3521 }
3522
3523 //==========================================================================
3524 //
3525 //  ufoStoreLocal
3526 //
3527 //==========================================================================
3528 UFO_FORCE_INLINE void ufoStoreLocal (const uint32_t lidx) {
3529   const uint32_t value = ufoPop();
3530   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index");
3531   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
3532   ufoLStack[ufoLBP + lidx] = value;
3533 }
3534
3535 // (LOCAL@)
3536 // ( idx -- value )
3537 UFWORD(PAR_LOCAL_LOAD) { ufoLoadLocal(ufoPop()); }
3538
3539 // (LOCAL!)
3540 // ( value idx -- )
3541 UFWORD(PAR_LOCAL_STORE) { ufoStoreLocal(ufoPop()); }
3542
3543
3544 // ////////////////////////////////////////////////////////////////////////// //
3545 // stack manipulation
3546 //
3547
3548 // DUP
3549 // ( n -- n n )
3550 UFWORD(DUP) { ufoDup(); }
3551 // ?DUP
3552 // ( n -- n n ) | ( 0 -- 0 )
3553 UFWORD(QDUP) { if (ufoPeek()) ufoDup(); }
3554 // 2DUP
3555 // ( n0 n1 -- n0 n1 n0 n1 )
3556 UFWORD(DDUP) { ufo2Dup(); }
3557 // DROP
3558 // ( n -- )
3559 UFWORD(DROP) { ufoDrop(); }
3560 // 2DROP
3561 // ( n0 n1 -- )
3562 UFWORD(DDROP) { ufo2Drop(); }
3563 // SWAP
3564 // ( n0 n1 -- n1 n0 )
3565 UFWORD(SWAP) { ufoSwap(); }
3566 // 2SWAP
3567 // ( n0 n1 -- n1 n0 )
3568 UFWORD(DSWAP) { ufo2Swap(); }
3569 // OVER
3570 // ( n0 n1 -- n0 n1 n0 )
3571 UFWORD(OVER) { ufoOver(); }
3572 // 2OVER
3573 // ( n0 n1 -- n0 n1 n0 )
3574 UFWORD(DOVER) { ufo2Over(); }
3575 // ROT
3576 // ( n0 n1 n2 -- n1 n2 n0 )
3577 UFWORD(ROT) { ufoRot(); }
3578 // NROT
3579 // ( n0 n1 n2 -- n2 n0 n1 )
3580 UFWORD(NROT) { ufoNRot(); }
3581
3582 // RDUP
3583 // ( n -- n n )
3584 UFWORD(RDUP) { ufoRDup(); }
3585 // RDROP
3586 // ( n -- )
3587 UFWORD(RDROP) { ufoRDrop(); }
3588
3589 // >R
3590 // ( n -- | n )
3591 UFWORD(DTOR) { ufoRPush(ufoPop()); }
3592 // R>
3593 // ( | n -- n )
3594 UFWORD(RTOD) { ufoPush(ufoRPop()); }
3595 // R@
3596 // ( | n -- n | n)
3597 UFWORD(RPEEK) { ufoPush(ufoRPeek()); }
3598
3599 // PICK
3600 // ( idx -- n )
3601 UFWORD(PICK) {
3602   const uint32_t n = ufoPop();
3603   if (n >= ufoSP) ufoFatal("invalid PICK index %u", n);
3604   ufoPush(ufoDStack[ufoSP - n - 1u]);
3605 }
3606
3607 // RPICK
3608 // ( idx -- n )
3609 UFWORD(RPICK) {
3610   const uint32_t n = ufoPop();
3611   if (n >= ufoRP - ufoRPTop) ufoFatal("invalid RPICK index %u", n);
3612   const uint32_t rp = ufoRP - n - 1u;
3613   ufoPush(ufoRStack[rp]);
3614 }
3615
3616 // ROLL
3617 // ( idx -- n )
3618 UFWORD(ROLL) {
3619   const uint32_t n = ufoPop();
3620   if (n >= ufoSP) ufoFatal("invalid ROLL index %u", n);
3621   switch (n) {
3622     case 0: break; // do nothing
3623     case 1: ufoSwap(); break;
3624     case 2: ufoRot(); break;
3625     default:
3626       {
3627         const uint32_t val = ufoDStack[ufoSP - n - 1u];
3628         for (uint32_t f = ufoSP - n; f < ufoSP; f += 1) ufoDStack[f - 1] = ufoDStack[f];
3629         ufoDStack[ufoSP - 1u] = val;
3630       }
3631       break;
3632   }
3633 }
3634
3635 // RROLL
3636 // ( idx -- n )
3637 UFWORD(RROLL) {
3638   const uint32_t n = ufoPop();
3639   if (n >= ufoRP - ufoRPTop) ufoFatal("invalid RROLL index %u", n);
3640   if (n != 0) {
3641     const uint32_t rp = ufoRP - n - 1u;
3642     const uint32_t val = ufoRStack[rp];
3643     for (uint32_t f = rp + 1u; f < ufoRP; f += 1u) ufoRStack[f - 1u] = ufoRStack[f];
3644     ufoRStack[ufoRP - 1u] = val;
3645   }
3646 }
3647
3648 // RSWAP
3649 // ( | a b -- | b a )
3650 UFWORD(RSWAP) {
3651   const uint32_t b = ufoRPop();
3652   const uint32_t a = ufoRPop();
3653   ufoRPush(b); ufoRPush(a);
3654 }
3655
3656 // ROVER
3657 // ( | a b -- | a b a )
3658 UFWORD(ROVER) {
3659   const uint32_t b = ufoRPop();
3660   const uint32_t a = ufoRPop();
3661   ufoRPush(a); ufoRPush(b); ufoRPush(a);
3662 }
3663
3664 // RROT
3665 // ( | a b c -- | b c a )
3666 UFWORD(RROT) {
3667   const uint32_t c = ufoRPop();
3668   const uint32_t b = ufoRPop();
3669   const uint32_t a = ufoRPop();
3670   ufoRPush(b); ufoRPush(c); ufoRPush(a);
3671 }
3672
3673 // RNROT
3674 // ( | a b c -- | c a b )
3675 UFWORD(RNROT) {
3676   const uint32_t c = ufoRPop();
3677   const uint32_t b = ufoRPop();
3678   const uint32_t a = ufoRPop();
3679   ufoRPush(c); ufoRPush(a); ufoRPush(b);
3680 }
3681
3682
3683 // ////////////////////////////////////////////////////////////////////////// //
3684 // TIB API
3685 //
3686
3687 // REFILL
3688 // ( -- eofflag )
3689 UFWORD(REFILL) {
3690   ufoPushBool(ufoLoadNextLine(1));
3691 }
3692
3693 // REFILL-NOCROSS
3694 // ( -- eofflag )
3695 UFWORD(REFILL_NOCROSS) {
3696   ufoPushBool(ufoLoadNextLine(0));
3697 }
3698
3699 // (TIB-IN)
3700 // ( -- addr )
3701 UFWORD(TIB_IN) {
3702   ufoPush(ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx));
3703 }
3704
3705 // TIB-PEEKCH
3706 // ( -- char )
3707 UFWORD(TIB_PEEKCH) {
3708   ufoPush(ufoTibPeekCh());
3709 }
3710
3711 // TIB-PEEKCH-OFS
3712 // ( ofs -- char )
3713 UFWORD(TIB_PEEKCH_OFS) {
3714   const uint32_t ofs = ufoPop();
3715   ufoPush(ufoTibPeekChOfs(ofs));
3716 }
3717
3718 // TIB-GETCH
3719 // ( -- char )
3720 UFWORD(TIB_GETCH) {
3721   ufoPush(ufoTibGetCh());
3722 }
3723
3724 // TIB-SKIPCH
3725 // ( -- )
3726 UFWORD(TIB_SKIPCH) {
3727   ufoTibSkipCh();
3728 }
3729
3730
3731 // ////////////////////////////////////////////////////////////////////////// //
3732 // TIB parsing
3733 //
3734
3735 //==========================================================================
3736 //
3737 //  ufoIsDelim
3738 //
3739 //==========================================================================
3740 UFO_FORCE_INLINE int ufoIsDelim (uint8_t ch, uint8_t delim) {
3741   return (delim == 32 ? (ch <= 32) : (ch == delim));
3742 }
3743
3744 // (PARSE)
3745 // ( delim skip-leading-delim? -- addr count TRUE / FALSE )
3746 // does base TIB parsing; never copies anything.
3747 // as our reader is line-based, returns FALSE on EOL.
3748 // EOL is detected after skipping leading delimiters.
3749 // passing -1 as delimiter skips the whole line, and always returns FALSE.
3750 // trailing delimiter is always skipped.
3751 UFWORD(PAR_PARSE) {
3752   const uint32_t skipDelim = ufoPop();
3753   const uint32_t delim = ufoPop();
3754   uint8_t ch;
3755
3756   if (delim == 0 || delim > 0xffU) {
3757     // skip everything
3758     while (ufoTibGetCh() != 0) {}
3759     ufoPushBool(0);
3760   } else {
3761     ch = ufoTibPeekCh();
3762     // skip initial delimiters
3763     if (skipDelim) {
3764       while (ch != 0 && ufoIsDelim(ch, delim)) {
3765         ufoTibSkipCh();
3766         ch = ufoTibPeekCh();
3767       }
3768     }
3769     if (ch == 0) {
3770       ufoPushBool(0);
3771     } else {
3772       // parse
3773       const uint32_t staddr = ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx);
3774       uint32_t count = 0;
3775       while (ch != 0 && !ufoIsDelim(ch, delim)) {
3776         count += 1u;
3777         ufoTibSkipCh();
3778         ch = ufoTibPeekCh();
3779       }
3780       // skip delimiter
3781       if (ch != 0) ufoTibSkipCh();
3782       ufoPush(staddr);
3783       ufoPush(count);
3784       ufoPushBool(1);
3785     }
3786   }
3787 }
3788
3789 // PARSE-SKIP-BLANKS
3790 // ( -- )
3791 UFWORD(PARSE_SKIP_BLANKS) {
3792   uint8_t ch = ufoTibPeekCh();
3793   while (ch != 0 && ch <= 32) {
3794     ufoTibSkipCh();
3795     ch = ufoTibPeekCh();
3796   }
3797 }
3798
3799 //==========================================================================
3800 //
3801 //  ufoParseMLComment
3802 //
3803 //  initial two chars are skipped
3804 //
3805 //==========================================================================
3806 static void ufoParseMLComment (uint32_t allowMulti, int nested) {
3807   uint32_t level = 1;
3808   uint8_t ch, ch1;
3809   while (level != 0) {
3810     ch = ufoTibGetCh();
3811     if (ch == 0) {
3812       if (allowMulti) {
3813         UFCALL(REFILL_NOCROSS);
3814         if (ufoPop() == 0) ufoFatal("unexpected end of file in comment");
3815       } else {
3816         ufoFatal("unexpected end of line in comment");
3817       }
3818     } else {
3819       ch1 = ufoTibPeekCh();
3820       if (nested && ch == '(' && ch1 == '(') { ufoTibSkipCh(); level += 1; }
3821       else if (nested && ch == ')' && ch1 == ')') { ufoTibSkipCh(); level -= 1; }
3822       else if (!nested && ch == '*' && ch1 == ')') { ufo_assert(level == 1); ufoTibSkipCh(); level = 0; }
3823     }
3824   }
3825 }
3826
3827 // (PARSE-SKIP-COMMENTS)
3828 // ( allow-multiline? -- )
3829 // skip all blanks and comments
3830 UFWORD(PAR_PARSE_SKIP_COMMENTS) {
3831   const uint32_t allowMulti = ufoPop();
3832   uint8_t ch, ch1;
3833   ch = ufoTibPeekCh();
3834   #if 0
3835   fprintf(stderr, "(PARSE-SKIP-COMMENTS): first-ch:'%c'\n", (char)ch);
3836   #endif
3837   while (ch != 0) {
3838     if (ch <= 32) {
3839       ufoTibSkipCh();
3840       ch = ufoTibPeekCh();
3841       #if 0
3842       fprintf(stderr, "(PARSE-SKIP-COMMENTS): blank-ch:'%c'\n", (char)ch);
3843       #endif
3844     } else if (ch == '(') {
3845       #if 0
3846       fprintf(stderr, "(PARSE-SKIP-COMMENTS): ch:'%c'; ch1:'%c' ('%c')\n", (char)ch, (char)ch1,
3847               ufoTibPeekChOfs(0));
3848       #endif
3849       ch1 = ufoTibPeekChOfs(1);
3850       if (ch1 <= 32) {
3851         // single-line comment
3852         do { ch = ufoTibGetCh(); } while (ch != 0 && ch != ')');
3853         ch = ufoTibPeekCh();
3854       } else if ((ch1 == '*' || ch1 == '(') && ufoTibPeekChOfs(2) <= 32) {
3855         // possibly multiline
3856         ufoTibSkipCh(); ufoTibSkipCh(); // skip opening
3857         ufoParseMLComment(allowMulti, (ch1 == '('));
3858         ch = ufoTibPeekCh();
3859       } else {
3860         ch = 0;
3861       }
3862     } else if (ch == '\\' && ufoTibPeekChOfs(1) <= 32) {
3863       // single-line comment
3864       while (ch != 0) ch = ufoTibGetCh();
3865     } else if ((ch == ';' || ch == '-' || ch == '/') && (ufoTibPeekChOfs(1) == ch)) {
3866       // skip to EOL
3867       while (ch != 0) ch = ufoTibGetCh();
3868     } else {
3869       ch = 0;
3870     }
3871   }
3872   #if 0
3873   fprintf(stderr, "(PARSE-SKIP-COMMENTS): end-ch:'%c'\n", ufoTibPeekCh());
3874   #endif
3875 }
3876
3877 // PARSE-SKIP-LINE
3878 // ( -- )
3879 UFWORD(PARSE_SKIP_LINE) {
3880   ufoPush(0); ufoPushBool(0); UFCALL(PAR_PARSE);
3881   if (ufoPop() != 0) {
3882     ufo2Drop();
3883   }
3884 }
3885
3886 // PARSE-NAME
3887 // ( -- addr count )
3888 // parse with leading blanks skipping. doesn't copy anything.
3889 // return empty string on EOL.
3890 UFWORD(PARSE_NAME) {
3891   ufoPush(32); ufoPushBool(1); UFCALL(PAR_PARSE);
3892   if (ufoPop() == 0) {
3893     ufoPush(0);
3894     ufoPush(0);
3895   }
3896 }
3897
3898 // PARSE
3899 // ( delim -- addr count TRUE / FALSE )
3900 // parse without skipping delimiters; never copies anything.
3901 // as our reader is line-based, returns FALSE on EOL.
3902 // passing 0 as delimiter skips the whole line, and always returns FALSE.
3903 // trailing delimiter is always skipped.
3904 UFWORD(PARSE) {
3905   ufoPushBool(0); UFCALL(PAR_PARSE);
3906 }
3907
3908
3909 // ////////////////////////////////////////////////////////////////////////// //
3910 // char output
3911 //
3912
3913 // (NORM-EMIT-CHAR)
3914 // ( ch -- )
3915 UFWORD(PAR_NORM_EMIT_CHAR) {
3916   uint32_t ch = ufoPop()&0xffU;
3917   if (ch < 32 || ch == 127) {
3918     if (ch != 9 && ch != 10 && ch != 13) ch = '?';
3919   }
3920   ufoPush(ch);
3921 }
3922
3923 // (NORM-XEMIT-CHAR)
3924 // ( ch -- )
3925 UFWORD(PAR_NORM_XEMIT_CHAR) {
3926   uint32_t ch = ufoPop()&0xffU;
3927   if (ch < 32 || ch == 127) ch = '?';
3928   ufoPush(ch);
3929 }
3930
3931 // (EMIT)
3932 // ( n -- )
3933 UFWORD(PAR_EMIT) {
3934   uint32_t ch = ufoPop()&0xffU;
3935   ufoLastEmitWasCR = (ch == 10);
3936   putchar((char)ch);
3937 }
3938
3939 // LASTCR?
3940 // ( -- bool )
3941 UFWORD(LASTCRQ) {
3942   ufoPushBool(ufoLastEmitWasCR);
3943 }
3944
3945 // LASTCR!
3946 // ( bool -- )
3947 UFWORD(LASTCRSET) {
3948   ufoLastEmitWasCR = !!ufoPop();
3949 }
3950
3951 // FLUSH-EMIT
3952 // ( -- )
3953 UFWORD(FLUSH_EMIT) {
3954   ufoFlushOutput();
3955 }
3956
3957
3958 // ////////////////////////////////////////////////////////////////////////// //
3959 // simple math
3960 //
3961
3962 #define UF_UMATH(name_,op_)  \
3963 UFWORD(name_) { \
3964   const uint32_t a = ufoPop(); \
3965   ufoPush(op_); \
3966 }
3967
3968 #define UF_BMATH(name_,op_)  \
3969 UFWORD(name_) { \
3970   const uint32_t b = ufoPop(); \
3971   const uint32_t a = ufoPop(); \
3972   ufoPush(op_); \
3973 }
3974
3975 #define UF_BDIV(name_,op_)  \
3976 UFWORD(name_) { \
3977   const uint32_t b = ufoPop(); \
3978   const uint32_t a = ufoPop(); \
3979   if (b == 0) ufoFatal("division by zero"); \
3980   ufoPush(op_); \
3981 }
3982
3983 #define UFO_POP_U64()  ({ \
3984   const uint32_t hi_ = ufoPop(); \
3985   const uint32_t lo_ = ufoPop(); \
3986   (((uint64_t)hi_ << 32) | lo_); \
3987 })
3988
3989 // this is UB by the idiotic C standard. i don't care.
3990 #define UFO_POP_I64()  ((int64_t)UFO_POP_U64())
3991
3992 #define UFO_PUSH_U64(vn_)  do { \
3993   ufoPush((uint32_t)(vn_)); \
3994   ufoPush((uint32_t)((vn_) >> 32)); \
3995 } while (0)
3996
3997 // this is UB by the idiotic C standard. i don't care.
3998 #define UFO_PUSH_I64(vn_)  UFO_PUSH_U64((uint64_t)(vn_))
3999
4000 // +
4001 // ( a b -- a+b )
4002 UF_BMATH(PLUS, a + b);
4003
4004 // -
4005 // ( a b -- a-b )
4006 UF_BMATH(MINUS, a - b);
4007
4008 // *
4009 // ( a b -- a*b )
4010 UF_BMATH(MUL, (uint32_t)((int32_t)a * (int32_t)b));
4011
4012 // U*
4013 // ( a b -- a*b )
4014 UF_BMATH(UMUL, a * b);
4015
4016 // /
4017 // ( a b -- a/b )
4018 UF_BDIV(DIV, (uint32_t)((int32_t)a / (int32_t)b));
4019
4020 // U/
4021 // ( a b -- a/b )
4022 UF_BDIV(UDIV, a / b);
4023
4024 // MOD
4025 // ( a b -- a%b )
4026 UF_BDIV(MOD, (uint32_t)((int32_t)a % (int32_t)b));
4027
4028 // UMOD
4029 // ( a b -- a%b )
4030 UF_BDIV(UMOD, a % b);
4031
4032 // /MOD
4033 // ( a b -- a/b, a%b )
4034 UFWORD(DIVMOD) {
4035   const int32_t b = (int32_t)ufoPop();
4036   const int32_t a = (int32_t)ufoPop();
4037   if (b == 0) ufoFatal("division by zero");
4038   ufoPush((uint32_t)(a/b));
4039   ufoPush((uint32_t)(a%b));
4040 }
4041
4042 // U/MOD
4043 // ( a b -- a/b, a%b )
4044 UFWORD(UDIVMOD) {
4045   const uint32_t b = ufoPop();
4046   const uint32_t a = ufoPop();
4047   if (b == 0) ufoFatal("division by zero");
4048   ufoPush((uint32_t)(a/b));
4049   ufoPush((uint32_t)(a%b));
4050 }
4051
4052 // */
4053 // ( a b c -- a*b/c )
4054 // this uses 64-bit intermediate value
4055 UFWORD(MULDIV) {
4056   const int32_t c = (int32_t)ufoPop();
4057   const int32_t b = (int32_t)ufoPop();
4058   const int32_t a = (int32_t)ufoPop();
4059   if (c == 0) ufoFatal("division by zero");
4060   int64_t xval = a; xval *= b; xval /= c;
4061   ufoPush((uint32_t)(int32_t)xval);
4062 }
4063
4064 // U*/
4065 // ( a b c -- a*b/c )
4066 // this uses 64-bit intermediate value
4067 UFWORD(UMULDIV) {
4068   const uint32_t c = ufoPop();
4069   const uint32_t b = ufoPop();
4070   const uint32_t a = ufoPop();
4071   if (c == 0) ufoFatal("division by zero");
4072   uint64_t xval = a; xval *= b; xval /= c;
4073   ufoPush((uint32_t)xval);
4074 }
4075
4076 // */MOD
4077 // ( a b c -- a*b/c a*b%c )
4078 // this uses 64-bit intermediate value
4079 UFWORD(MULDIVMOD) {
4080   const int32_t c = (int32_t)ufoPop();
4081   const int32_t b = (int32_t)ufoPop();
4082   const int32_t a = (int32_t)ufoPop();
4083   if (c == 0) ufoFatal("division by zero");
4084   int64_t xval = a; xval *= b;
4085   ufoPush((uint32_t)(int32_t)(xval / c));
4086   ufoPush((uint32_t)(int32_t)(xval % c));
4087 }
4088
4089 // U*/
4090 // ( a b c -- a*b/c )
4091 // this uses 64-bit intermediate value
4092 UFWORD(UMULDIVMOD) {
4093   const uint32_t c = ufoPop();
4094   const uint32_t b = ufoPop();
4095   const uint32_t a = ufoPop();
4096   if (c == 0) ufoFatal("division by zero");
4097   uint64_t xval = a; xval *= b;
4098   ufoPush((uint32_t)(xval / c));
4099   ufoPush((uint32_t)(xval % c));
4100 }
4101
4102 // M*
4103 // ( a b -- lo(a*b) hi(a*b) )
4104 // this leaves 64-bit result
4105 UFWORD(MMUL) {
4106   const int32_t b = (int32_t)ufoPop();
4107   const int32_t a = (int32_t)ufoPop();
4108   int64_t xval = a; xval *= b;
4109   UFO_PUSH_I64(xval);
4110 }
4111
4112 // UM*
4113 // ( a b -- lo(a*b) hi(a*b) )
4114 // this leaves 64-bit result
4115 UFWORD(UMMUL) {
4116   const uint32_t b = ufoPop();
4117   const uint32_t a = ufoPop();
4118   uint64_t xval = a; xval *= b;
4119   UFO_PUSH_U64(xval);
4120 }
4121
4122 // M/MOD
4123 // ( alo ahi b -- a/b a%b )
4124 UFWORD(MDIVMOD) {
4125   const int32_t b = (int32_t)ufoPop();
4126   if (b == 0) ufoFatal("division by zero");
4127   int64_t a = UFO_POP_I64();
4128   int32_t adiv = (int32_t)(a / b);
4129   int32_t amod = (int32_t)(a % b);
4130   ufoPush((uint32_t)adiv);
4131   ufoPush((uint32_t)amod);
4132 }
4133
4134 // UM/MOD
4135 // ( alo ahi b -- a/b a%b )
4136 UFWORD(UMDIVMOD) {
4137   const uint32_t b = ufoPop();
4138   if (b == 0) ufoFatal("division by zero");
4139   uint64_t a = UFO_POP_U64();
4140   uint32_t adiv = (uint32_t)(a / b);
4141   uint32_t amod = (uint32_t)(a % b);
4142   ufoPush(adiv);
4143   ufoPush(amod);
4144 }
4145
4146 // UDS*
4147 // ( alo ahi u -- lo hi )
4148 UFWORD(UDSMUL) {
4149   const uint32_t b = ufoPop();
4150   uint64_t a = UFO_POP_U64();
4151   a *= b;
4152   UFO_PUSH_U64(a);
4153 }
4154
4155 // D-
4156 // ( lo0 hi0 lo1 hi1 -- lo hi )
4157 UFWORD(DMINUS) {
4158   uint64_t n1 = UFO_POP_U64();
4159   uint64_t n0 = UFO_POP_U64();
4160   n0 -= n1;
4161   UFO_PUSH_U64(n0);
4162 }
4163
4164 // D+
4165 // ( lo0 hi0 lo1 hi1 -- lo hi )
4166 UFWORD(DPLUS) {
4167   uint64_t n1 = UFO_POP_U64();
4168   uint64_t n0 = UFO_POP_U64();
4169   n0 += n1;
4170   UFO_PUSH_U64(n0);
4171 }
4172
4173 // D=
4174 // ( lo0 hi0 lo1 hi1 -- bool )
4175 UFWORD(DEQU) {
4176   uint64_t n1 = UFO_POP_U64();
4177   uint64_t n0 = UFO_POP_U64();
4178   ufoPushBool(n0 == n1);
4179 }
4180
4181 // D<
4182 // ( lo0 hi0 lo1 hi1 -- bool )
4183 UFWORD(DLESS) {
4184   int64_t n1 = UFO_POP_I64();
4185   int64_t n0 = UFO_POP_I64();
4186   ufoPushBool(n0 < n1);
4187 }
4188
4189 // D<=
4190 // ( lo0 hi0 lo1 hi1 -- bool )
4191 UFWORD(DLESSEQU) {
4192   int64_t n1 = UFO_POP_I64();
4193   int64_t n0 = UFO_POP_I64();
4194   ufoPushBool(n0 <= n1);
4195 }
4196
4197 // DU<
4198 // ( lo0 hi0 lo1 hi1 -- bool )
4199 UFWORD(DULESS) {
4200   uint64_t n1 = UFO_POP_U64();
4201   uint64_t n0 = UFO_POP_U64();
4202   ufoPushBool(n0 < n1);
4203 }
4204
4205 // DU<=
4206 // ( lo0 hi0 lo1 hi1 -- bool )
4207 UFWORD(DULESSEQU) {
4208   uint64_t n1 = UFO_POP_U64();
4209   uint64_t n0 = UFO_POP_U64();
4210   ufoPushBool(n0 <= n1);
4211 }
4212
4213 // SM/REM
4214 // ( dlo dhi n -- nmod ndiv )
4215 // rounds toward zero
4216 UFWORD(SMREM) {
4217   const int32_t n = (int32_t)ufoPop();
4218   if (n == 0) ufoFatal("division by zero");
4219   int64_t d = UFO_POP_I64();
4220   int32_t ndiv = (int32_t)(d / n);
4221   int32_t nmod = (int32_t)(d % n);
4222   ufoPush(nmod);
4223   ufoPush(ndiv);
4224 }
4225
4226 // FM/MOD
4227 // ( dlo dhi n -- nmod ndiv )
4228 // rounds toward negative infinity
4229 UFWORD(FMMOD) {
4230   const int32_t n = (int32_t)ufoPop();
4231   if (n == 0) ufoFatal("division by zero");
4232   int64_t d = UFO_POP_I64();
4233   int32_t ndiv = (int32_t)(d / n);
4234   int32_t nmod = (int32_t)(d % n);
4235   if (nmod != 0 && ((uint32_t)n ^ (uint32_t)(d >> 32)) >= 0x80000000u) {
4236     ndiv -= 1;
4237     nmod += n;
4238   }
4239   ufoPush(nmod);
4240   ufoPush(ndiv);
4241 }
4242
4243
4244 // ////////////////////////////////////////////////////////////////////////// //
4245 // simple logic and bit manipulation
4246 //
4247
4248 #define UF_CMP(name_,op_)  \
4249 UFWORD(name_) { \
4250   const uint32_t b = ufoPop(); \
4251   const uint32_t a = ufoPop(); \
4252   ufoPushBool(op_); \
4253 }
4254
4255 // <
4256 // ( a b -- a<b )
4257 UF_CMP(LESS, (int32_t)a < (int32_t)b);
4258
4259 // U<
4260 // ( a b -- a<b )
4261 UF_CMP(ULESS, a < b);
4262
4263 // >
4264 // ( a b -- a>b )
4265 UF_CMP(GREAT, (int32_t)a > (int32_t)b);
4266
4267 // U>
4268 // ( a b -- a>b )
4269 UF_CMP(UGREAT, a > b);
4270
4271 // <=
4272 // ( a b -- a<=b )
4273 UF_CMP(LESSEQU, (int32_t)a <= (int32_t)b);
4274
4275 // U<=
4276 // ( a b -- a<=b )
4277 UF_CMP(ULESSEQU, a <= b);
4278
4279 // >=
4280 // ( a b -- a>=b )
4281 UF_CMP(GREATEQU, (int32_t)a >= (int32_t)b);
4282
4283 // U>=
4284 // ( a b -- a>=b )
4285 UF_CMP(UGREATEQU, a >= b);
4286
4287 // =
4288 // ( a b -- a=b )
4289 UF_CMP(EQU, a == b);
4290
4291 // <>
4292 // ( a b -- a<>b )
4293 UF_CMP(NOTEQU, a != b);
4294
4295 // 0=
4296 // ( a -- a==0 )
4297 UFWORD(ZERO_EQU) {
4298   const uint32_t a = ufoPop();
4299   ufoPushBool(a == 0);
4300 }
4301
4302 // 0<>
4303 // ( a -- a<>0 )
4304 UFWORD(ZERO_NOTEQU) {
4305   const uint32_t a = ufoPop();
4306   ufoPushBool(a != 0);
4307 }
4308
4309 // LAND
4310 // ( a b -- a&&b )
4311 UF_CMP(LOGAND, a && b);
4312
4313 // LOR
4314 // ( a b -- a||b )
4315 UF_CMP(LOGOR, a || b);
4316
4317 // AND
4318 // ( a b -- a&b )
4319 UFWORD(AND) {
4320   const uint32_t b = ufoPop();
4321   const uint32_t a = ufoPop();
4322   ufoPush(a&b);
4323 }
4324
4325 // OR
4326 // ( a b -- a|b )
4327 UFWORD(OR) {
4328   const uint32_t b = ufoPop();
4329   const uint32_t a = ufoPop();
4330   ufoPush(a|b);
4331 }
4332
4333 // XOR
4334 // ( a b -- a^b )
4335 UFWORD(XOR) {
4336   const uint32_t b = ufoPop();
4337   const uint32_t a = ufoPop();
4338   ufoPush(a^b);
4339 }
4340
4341 // BITNOT
4342 // ( a -- ~a )
4343 UFWORD(BITNOT) {
4344   const uint32_t a = ufoPop();
4345   ufoPush(~a);
4346 }
4347
4348 // ASH
4349 // ( n count -- )
4350 // arithmetic shift; positive `n` shifts to the left
4351 UFWORD(ASH) {
4352   int32_t c = (int32_t)ufoPop();
4353   if (c < 0) {
4354     // right
4355     int32_t n = (int32_t)ufoPop();
4356     if (c < -30) {
4357       if (n < 0) n = -1; else n = 0;
4358     } else {
4359       n >>= (uint8_t)(-c);
4360     }
4361     ufoPush((uint32_t)n);
4362   } else if (c > 0) {
4363     // left
4364     uint32_t u = ufoPop();
4365     if (c > 31) {
4366       u = 0;
4367     } else {
4368       u <<= (uint8_t)c;
4369     }
4370     ufoPush(u);
4371   }
4372 }
4373
4374 // LSH
4375 // ( n count -- )
4376 // logical shift; positive `n` shifts to the left
4377 UFWORD(LSH) {
4378   int32_t c = (int32_t) ufoPop();
4379   uint32_t u = ufoPop();
4380   if (c < 0) {
4381     // right
4382     if (c < -31) {
4383       u = 0;
4384     } else {
4385       u >>= (uint8_t)(-c);
4386     }
4387   } else if (c > 0) {
4388     // left
4389     if (c > 31) {
4390       u = 0;
4391     } else {
4392       u <<= (uint8_t)c;
4393     }
4394   }
4395   ufoPush(u);
4396 }
4397
4398
4399 // ////////////////////////////////////////////////////////////////////////// //
4400 // string unescaping
4401 //
4402
4403 // (UNESCAPE)
4404 // ( addr count -- addr count )
4405 UFWORD(PAR_UNESCAPE) {
4406   const uint32_t count = ufoPop();
4407   const uint32_t addr = ufoPeek();
4408   if ((count & ((uint32_t)1<<31)) == 0) {
4409     const uint32_t eaddr = addr + count;
4410     uint32_t caddr = addr;
4411     uint32_t daddr = addr;
4412     while (caddr != eaddr) {
4413       uint8_t ch = ufoImgGetU8Ext(caddr); caddr += 1u;
4414       if (ch == '\\' && caddr != eaddr) {
4415         ch = ufoImgGetU8Ext(caddr); caddr += 1u;
4416         switch (ch) {
4417           case 'r': ch = '\r'; break;
4418           case 'n': ch = '\n'; break;
4419           case 't': ch = '\t'; break;
4420           case 'e': ch = '\x1b'; break;
4421           case '`': ch = '"'; break; // special escape to insert double-quote
4422           case '"': ch = '"'; break;
4423           case '\\': ch = '\\'; break;
4424           case 'x': case 'X':
4425             if (eaddr - daddr >= 1) {
4426               const int dg0 = digitInBase((char)(ufoImgGetU8Ext(caddr)), 16);
4427               if (dg0 < 0) ufoFatal("invalid hex string escape");
4428               if (eaddr - daddr >= 2) {
4429                 const int dg1 = digitInBase((char)(ufoImgGetU8Ext(caddr + 1u)), 16);
4430                 if (dg1 < 0) ufoFatal("invalid hex string escape");
4431                 ch = (uint8_t)(dg0 * 16 + dg1);
4432                 caddr += 2u;
4433               } else {
4434                 ch = (uint8_t)dg0;
4435                 caddr += 1u;
4436               }
4437             } else {
4438               ufoFatal("invalid hex string escape");
4439             }
4440             break;
4441           default: ufoFatal("invalid string escape");
4442         }
4443       }
4444       ufoImgPutU8Ext(daddr, ch); daddr += 1u;
4445     }
4446     ufoPush(daddr - addr);
4447   } else {
4448     ufoPush(count);
4449   }
4450 }
4451
4452
4453 // ////////////////////////////////////////////////////////////////////////// //
4454 // numeric conversions
4455 //
4456
4457 // (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
4458 UFWORD(PAR_BASED_NUMBER) {
4459   const uint32_t xbase = ufoPop();
4460   const uint32_t allowSign = ufoPop();
4461   int32_t count = (int32_t)ufoPop();
4462   uint32_t addr = ufoPop();
4463   uint32_t n = 0;
4464   int base = 0;
4465   int neg = 0;
4466   uint8_t ch;
4467
4468   if (allowSign && count > 1) {
4469     ch = ufoImgGetU8Ext(addr);
4470     if (ch == '-') { neg = 1; addr += 1u; count -= 1; }
4471     else if (ch == '+') { neg = 0; addr += 1u; count -= 1; }
4472   }
4473
4474   // special-based numbers
4475   if (count >= 3 && ufoImgGetU8Ext(addr) == '0') {
4476     switch (ufoImgGetU8Ext(addr + 1u)) {
4477       case 'x': case 'X': base = 16; break;
4478       case 'o': case 'O': base = 8; break;
4479       case 'b': case 'B': base = 2; break;
4480       case 'd': case 'D': base = 10; break;
4481       default: break;
4482     }
4483     if (base) { addr += 2; count -= 2; }
4484   } else if (count >= 2 && ufoImgGetU8Ext(addr) == '$') {
4485     base = 16;
4486     addr += 1; count -= 1;
4487   } else if (count >= 2 && ufoImgGetU8Ext(addr) == '#') {
4488     base = 16;
4489     addr += 1; count -= 1;
4490   } else if (count >= 2 && ufoImgGetU8Ext(addr) == '%') {
4491     base = 2;
4492     addr += 1; count -= 1;
4493   } else if (count >= 3 && ufoImgGetU8Ext(addr) == '&') {
4494     switch (ufoImgGetU8Ext(addr + 1u)) {
4495       case 'h': case 'H': base = 16; break;
4496       case 'o': case 'O': base = 8; break;
4497       case 'b': case 'B': base = 2; break;
4498       case 'd': case 'D': base = 10; break;
4499       default: break;
4500     }
4501     if (base) { addr += 2; count -= 2; }
4502   } else if (xbase < 12 && count > 2 && toUpperU8(ufoImgGetU8Ext(addr + (uint32_t)count - 1u)) == 'B') {
4503     base = 2;
4504     count -= 1;
4505   } else if (xbase < 18 && count > 2 && toUpperU8(ufoImgGetU8Ext(addr + (uint32_t)count - 1u)) == 'H') {
4506     base = 16;
4507     count -= 1;
4508   } else if (xbase < 25 && count > 2 && toUpperU8(ufoImgGetU8Ext(addr + (uint32_t)count - 1u)) == 'O') {
4509     base = 8;
4510     count -= 1;
4511   }
4512
4513   // in current base?
4514   if (!base && xbase < 255) base = xbase;
4515
4516   if (count <= 0 || base < 1 || base > 36) {
4517     ufoPushBool(0);
4518   } else {
4519     uint32_t nc;
4520     int wasDig = 0, wasUnder = 1, error = 0, dig;
4521     while (!error && count != 0) {
4522       ch = ufoImgGetU8Ext(addr); addr += 1u; count -= 1;
4523       if (ch != '_') {
4524         error = 1; wasUnder = 0; wasDig = 1;
4525         dig = digitInBase((char)ch, (int)base);
4526         if (dig >= 0) {
4527           nc = n * (uint32_t)base;
4528           if (nc >= n) {
4529             nc += (uint32_t)dig;
4530             if (nc >= n) {
4531               n = nc;
4532               error = 0;
4533             }
4534           }
4535         }
4536       } else {
4537         error = wasUnder;
4538         wasUnder = 1;
4539       }
4540     }
4541
4542     if (!error && wasDig && !wasUnder) {
4543       if (allowSign && neg) n = ~n + 1u;
4544       ufoPush(n);
4545       ufoPushBool(1);
4546     } else {
4547       ufoPushBool(0);
4548     }
4549   }
4550 }
4551
4552
4553 // ////////////////////////////////////////////////////////////////////////// //
4554 // compiler-related, dictionary-related
4555 //
4556
4557 static char ufoWNameBuf[256];
4558
4559 // (CREATE-WORD-HEADER)
4560 // ( addr count word-flags -- )
4561 UFWORD(PAR_CREATE_WORD_HEADER) {
4562   const uint32_t flags = ufoPop();
4563   const uint32_t wlen = ufoPop();
4564   const uint32_t waddr = ufoPop();
4565   if (wlen == 0) ufoFatal("word name expected");
4566   if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
4567   // copy to separate buffer
4568   for (uint32_t f = 0; f < wlen; f += 1) {
4569     ufoWNameBuf[f] = (char)ufoImgGetU8Ext(waddr + f);
4570   }
4571   ufoWNameBuf[wlen] = 0;
4572   ufoCreateWordHeader(ufoWNameBuf, flags);
4573 }
4574
4575 // (CREATE-NAMELESS-WORD-HEADER)
4576 // ( word-flags -- )
4577 UFWORD(PAR_CREATE_NAMELESS_WORD_HEADER) {
4578   const uint32_t flags = ufoPop();
4579   ufoCreateWordHeader("", flags);
4580 }
4581
4582 // FIND-WORD
4583 // ( addr count -- cfa TRUE / FALSE)
4584 UFWORD(FIND_WORD) {
4585   const uint32_t wlen = ufoPop();
4586   const uint32_t waddr = ufoPop();
4587   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
4588     // copy to separate buffer
4589     for (uint32_t f = 0; f < wlen; f += 1) {
4590       ufoWNameBuf[f] = (char)ufoImgGetU8Ext(waddr + f);
4591     }
4592     ufoWNameBuf[wlen] = 0;
4593     const uint32_t cfa = ufoFindWord(ufoWNameBuf);
4594     if (cfa != 0) {
4595       ufoPush(cfa);
4596       ufoPushBool(1);
4597     } else {
4598       ufoPushBool(0);
4599     }
4600   } else {
4601     ufoPushBool(0);
4602   }
4603 }
4604
4605 // (FIND-WORD-IN-VOC)
4606 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
4607 // find only in the given voc; no name resolution
4608 UFWORD(FIND_WORD_IN_VOC) {
4609   const uint32_t allowHidden = ufoPop();
4610   const uint32_t vocid = ufoPop();
4611   const uint32_t wlen = ufoPop();
4612   const uint32_t waddr = ufoPop();
4613   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
4614     // copy to separate buffer
4615     for (uint32_t f = 0; f < wlen; f += 1) {
4616       ufoWNameBuf[f] = (char)ufoImgGetU8Ext(waddr + f);
4617     }
4618     ufoWNameBuf[wlen] = 0;
4619     const uint32_t cfa = ufoFindWordInVoc(ufoWNameBuf, wlen, 0, vocid, (allowHidden ? 1 : 0));
4620     if (cfa != 0) {
4621       ufoPush(cfa);
4622       ufoPushBool(1);
4623     } else {
4624       ufoPushBool(0);
4625     }
4626   } else {
4627     ufoPushBool(0);
4628   }
4629 }
4630
4631 // (FIND-WORD-IN-VOC-AND-PARENTS)
4632 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
4633 // find only in the given voc; no name resolution
4634 UFWORD(FIND_WORD_IN_VOC_AND_PARENTS) {
4635   const uint32_t allowHidden = ufoPop();
4636   const uint32_t vocid = ufoPop();
4637   const uint32_t wlen = ufoPop();
4638   const uint32_t waddr = ufoPop();
4639   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
4640     // copy to separate buffer
4641     for (uint32_t f = 0; f < wlen; f += 1) {
4642       ufoWNameBuf[f] = (char)ufoImgGetU8Ext(waddr + f);
4643     }
4644     ufoWNameBuf[wlen] = 0;
4645     const uint32_t cfa = ufoFindWordInVocAndParents(ufoWNameBuf, wlen, 0, vocid, (allowHidden ? 1 : 0));
4646     if (cfa != 0) {
4647       ufoPush(cfa);
4648       ufoPushBool(1);
4649     } else {
4650       ufoPushBool(0);
4651     }
4652   } else {
4653     ufoPushBool(0);
4654   }
4655 }
4656
4657
4658 // ////////////////////////////////////////////////////////////////////////// //
4659 // more compiler words
4660 //
4661
4662 // ////////////////////////////////////////////////////////////////////////// //
4663 // vocabulary and wordlist utilities
4664 //
4665
4666 // (VSP@)
4667 // ( -- vsp )
4668 UFWORD(PAR_GET_VSP) {
4669   ufoPush(ufoVSP);
4670 }
4671
4672 // (VSP!)
4673 // ( vsp -- )
4674 UFWORD(PAR_SET_VSP) {
4675   const uint32_t vsp = ufoPop();
4676   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
4677   ufoVSP = vsp;
4678 }
4679
4680 // (VSP-AT@)
4681 // ( idx -- value )
4682 UFWORD(PAR_VSP_LOAD) {
4683   const uint32_t vsp = ufoPop();
4684   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
4685   ufoPush(ufoVocStack[vsp]);
4686 }
4687
4688 // (VSP-AT!)
4689 // ( value idx -- )
4690 UFWORD(PAR_VSP_STORE) {
4691   const uint32_t vsp = ufoPop();
4692   const uint32_t value = ufoPop();
4693   if (vsp > UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
4694   ufoVocStack[vsp] = value;
4695 }
4696
4697
4698 // ////////////////////////////////////////////////////////////////////////// //
4699 // word field address conversion
4700 //
4701
4702 // CFA->PFA
4703 // ( cfa -- pfa )
4704 UFWORD(CFA2PFA) {
4705   const uint32_t cfa = ufoPop();
4706   ufoPush(UFO_CFA_TO_PFA(cfa));
4707 }
4708
4709 // CFA->NFA
4710 // ( cfa -- nfa )
4711 UFWORD(CFA2NFA) {
4712   const uint32_t cfa = ufoPop();
4713   ufoPush(UFO_CFA_TO_NFA(cfa));
4714 }
4715
4716 // CFA->LFA
4717 // ( cfa -- lfa )
4718 UFWORD(CFA2LFA) {
4719   const uint32_t cfa = ufoPop();
4720   ufoPush(UFO_CFA_TO_LFA(cfa));
4721 }
4722
4723 // CFA->WEND
4724 // ( cfa -- wend-addr )
4725 UFWORD(CFA2WEND) {
4726   const uint32_t cfa = ufoPop();
4727   ufoPush(ufoGetWordEndAddr(cfa));
4728 }
4729
4730 // PFA->CFA
4731 // ( pfa -- cfa )
4732 UFWORD(PFA2CFA) {
4733   const uint32_t pfa = ufoPop();
4734   ufoPush(UFO_PFA_TO_CFA(pfa));
4735 }
4736
4737 // PFA->NFA
4738 // ( pfa -- nfa )
4739 UFWORD(PFA2NFA) {
4740   const uint32_t pfa = ufoPop();
4741   const uint32_t cfa = UFO_PFA_TO_CFA(pfa);
4742   ufoPush(UFO_CFA_TO_NFA(cfa));
4743 }
4744
4745 // NFA->CFA
4746 // ( nfa -- cfa )
4747 UFWORD(NFA2CFA) {
4748   const uint32_t nfa = ufoPop();
4749   ufoPush(UFO_NFA_TO_CFA(nfa));
4750 }
4751
4752 // NFA->PFA
4753 // ( nfa -- pfa )
4754 UFWORD(NFA2PFA) {
4755   const uint32_t nfa = ufoPop();
4756   const uint32_t cfa = UFO_NFA_TO_CFA(nfa);
4757   ufoPush(UFO_CFA_TO_PFA(cfa));
4758 }
4759
4760 // NFA->LFA
4761 // ( nfa -- lfa )
4762 UFWORD(NFA2LFA) {
4763   const uint32_t nfa = ufoPop();
4764   ufoPush(UFO_NFA_TO_LFA(nfa));
4765 }
4766
4767 // LFA->CFA
4768 // ( lfa -- cfa )
4769 UFWORD(LFA2CFA) {
4770   const uint32_t lfa = ufoPop();
4771   ufoPush(UFO_LFA_TO_CFA(lfa));
4772 }
4773
4774 // LFA->PFA
4775 // ( lfa -- pfa )
4776 UFWORD(LFA2PFA) {
4777   const uint32_t lfa = ufoPop();
4778   const uint32_t cfa = UFO_LFA_TO_CFA(lfa);
4779   ufoPush(UFO_CFA_TO_PFA(cfa));
4780 }
4781
4782 // LFA->BFA
4783 // ( lfa -- bfa )
4784 UFWORD(LFA2BFA) {
4785   const uint32_t lfa = ufoPop();
4786   ufoPush(UFO_LFA_TO_BFA(lfa));
4787 }
4788
4789 // LFA->XFA
4790 // ( lfa -- xfa )
4791 UFWORD(LFA2XFA) {
4792   const uint32_t lfa = ufoPop();
4793   ufoPush(UFO_LFA_TO_XFA(lfa));
4794 }
4795
4796 // LFA->YFA
4797 // ( lfa -- yfa )
4798 UFWORD(LFA2YFA) {
4799   const uint32_t lfa = ufoPop();
4800   ufoPush(UFO_LFA_TO_YFA(lfa));
4801 }
4802
4803 // LFA->NFA
4804 // ( lfa -- nfa )
4805 UFWORD(LFA2NFA) {
4806   const uint32_t lfa = ufoPop();
4807   ufoPush(UFO_LFA_TO_NFA(lfa));
4808 }
4809
4810 // IP->NFA
4811 // ( ip -- nfa / 0 )
4812 UFWORD(IP2NFA) {
4813   const uint32_t ip = ufoPop();
4814   ufoPush(ufoFindWordForIP(ip));
4815 }
4816
4817 // IP->FILE/LINE
4818 // ( ip -- addr count line TRUE / FALSE )
4819 // name is at PAD; it is safe to use PAD, because each task has its own temp image
4820 UFWORD(IP2FILELINE) {
4821   const uint32_t ip = ufoPop();
4822   uint32_t fline;
4823   const char *fname = ufoFindFileForIP(ip, &fline, NULL, NULL);
4824   if (fname != NULL) {
4825     UFCALL(PAD);
4826     uint32_t addr = ufoPeek();
4827     uint32_t count = 0;
4828     while (*fname != 0) {
4829       ufoImgPutU8(addr, *(const unsigned char *)fname);
4830       fname += 1u; addr += 1u; count += 1u;
4831     }
4832     ufoImgPutU8(addr, 0); // just in case
4833     ufoPush(count);
4834     ufoPush(fline);
4835     ufoPushBool(1);
4836   } else {
4837     ufoPushBool(0);
4838   }
4839 }
4840
4841
4842 // IP->FILE-HASH/LINE
4843 // ( ip -- len hash line TRUE / FALSE )
4844 UFWORD(IP2FILEHASHLINE) {
4845   const uint32_t ip = ufoPop();
4846   uint32_t fline, fhash, flen;
4847   const char *fname = ufoFindFileForIP(ip, &fline, &flen, &fhash);
4848   if (fname != NULL) {
4849     ufoPush(flen);
4850     ufoPush(fhash);
4851     ufoPush(fline);
4852     ufoPushBool(1);
4853   } else {
4854     ufoPushBool(0);
4855   }
4856 }
4857
4858
4859 // ////////////////////////////////////////////////////////////////////////// //
4860 // string operations
4861 //
4862
4863 UFO_FORCE_INLINE uint32_t ufoHashBuf (uint32_t addr, uint32_t size, uint8_t orbyte) {
4864   uint32_t hash = 0x29a;
4865   if ((size & ((uint32_t)1<<31)) == 0) {
4866     while (size != 0) {
4867       hash += ufoImgGetU8Ext(addr) | orbyte;
4868       hash += hash<<10;
4869       hash ^= hash>>6;
4870       addr += 1u; size -= 1u;
4871     }
4872   }
4873   // finalize
4874   hash += hash<<3;
4875   hash ^= hash>>11;
4876   hash += hash<<15;
4877   return hash;
4878 }
4879
4880 //==========================================================================
4881 //
4882 //  ufoBufEqu
4883 //
4884 //==========================================================================
4885 UFO_FORCE_INLINE int ufoBufEqu (uint32_t addr0, uint32_t addr1, uint32_t count) {
4886   int res;
4887   if ((count & ((uint32_t)1<<31)) == 0) {
4888     res = 1;
4889     while (res != 0 && count != 0) {
4890       res = (toUpperU8(ufoImgGetU8Ext(addr0)) == toUpperU8(ufoImgGetU8Ext(addr1)));
4891       addr0 += 1u; addr1 += 1u; count -= 1u;
4892     }
4893   } else {
4894     res = 0;
4895   }
4896   return res;
4897 }
4898
4899 // STRING:=
4900 // ( a0 c0 a1 c1 -- bool )
4901 UFWORD(STREQU) {
4902   int32_t c1 = (int32_t)ufoPop();
4903   uint32_t a1 = ufoPop();
4904   int32_t c0 = (int32_t)ufoPop();
4905   uint32_t a0 = ufoPop();
4906   if (c0 < 0) c0 = 0;
4907   if (c1 < 0) c1 = 0;
4908   if (c0 == c1) {
4909     int res = 1;
4910     while (res != 0 && c0 != 0) {
4911       res = (ufoImgGetU8Ext(a0) == ufoImgGetU8Ext(a1));
4912       a0 += 1; a1 += 1; c0 -= 1;
4913     }
4914     ufoPushBool(res);
4915   } else {
4916     ufoPushBool(0);
4917   }
4918 }
4919
4920 // STRING:=CI
4921 // ( a0 c0 a1 c1 -- bool )
4922 UFWORD(STREQUCI) {
4923   int32_t c1 = (int32_t)ufoPop();
4924   uint32_t a1 = ufoPop();
4925   int32_t c0 = (int32_t)ufoPop();
4926   uint32_t a0 = ufoPop();
4927   if (c0 < 0) c0 = 0;
4928   if (c1 < 0) c1 = 0;
4929   if (c0 == c1) {
4930     int res = 1;
4931     while (res != 0 && c0 != 0) {
4932       res = (toUpperU8(ufoImgGetU8Ext(a0)) == toUpperU8(ufoImgGetU8Ext(a1)));
4933       a0 += 1; a1 += 1; c0 -= 1;
4934     }
4935     ufoPushBool(res);
4936   } else {
4937     ufoPushBool(0);
4938   }
4939 }
4940
4941 // search the string specified by c-addr1 u1 for the string specified by c-addr2 u2.
4942 // if flag is true, a match was found at c-addr3 with u3 characters remaining.
4943 // if flag is false there was no match and c-addr3 is c-addr1 and u3 is u1.
4944 // ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag )
4945 UFWORD(SEARCH) {
4946   const uint32_t pcount = ufoPop();
4947   const uint32_t paddr = ufoPop();
4948   const uint32_t tcount = ufoPop();
4949   const uint32_t taddr = ufoPop();
4950   if ((pcount & ((uint32_t)1 << 31)) == 0 && (tcount & ((uint32_t)1 << 31)) == 0) {
4951     for (uint32_t f = 0; tcount - f >= pcount; f += 1) {
4952       if (ufoBufEqu(taddr + f, paddr, pcount)) {
4953         ufoPush(taddr + f);
4954         ufoPush(tcount - f);
4955         ufoPushBool(1);
4956         return;
4957       }
4958     }
4959   }
4960   ufoPush(taddr);
4961   ufoPush(tcount);
4962   ufoPushBool(0);
4963 }
4964
4965 // STRING:HASH
4966 // ( addr count -- hash )
4967 UFWORD(STRHASH) {
4968   uint32_t count = ufoPop();
4969   uint32_t addr = ufoPop();
4970   ufoPush(ufoHashBuf(addr, count, 0));
4971 }
4972
4973 // STRING:HASH-CI
4974 // ( addr count -- hash )
4975 UFWORD(STRHASHCI) {
4976   uint32_t count = ufoPop();
4977   uint32_t addr = ufoPop();
4978   ufoPush(ufoHashBuf(addr, count, 0x20));
4979 }
4980
4981
4982 // ////////////////////////////////////////////////////////////////////////// //
4983 // conditional defines
4984 //
4985
4986 typedef struct UForthCondDefine_t UForthCondDefine;
4987 struct UForthCondDefine_t {
4988   char *name;
4989   uint32_t namelen;
4990   uint32_t hash;
4991   UForthCondDefine *next;
4992 };
4993
4994 static UForthCondDefine *ufoCondDefines = NULL;
4995 static char ufoErrMsgBuf[4096];
4996
4997
4998 //==========================================================================
4999 //
5000 //  ufoStrEquCI
5001 //
5002 //==========================================================================
5003 UFO_DISABLE_INLINE int ufoStrEquCI (const void *str0, const void *str1) {
5004   const unsigned char *s0 = (const unsigned char *)str0;
5005   const unsigned char *s1 = (const unsigned char *)str1;
5006   while (*s0 && *s1) {
5007     if (toUpperU8(*s0) != toUpperU8(*s1)) return 0;
5008     s0 += 1; s1 += 1;
5009   }
5010   return (*s0 == 0 && *s1 == 0);
5011 }
5012
5013
5014 //==========================================================================
5015 //
5016 //  ufoBufEquCI
5017 //
5018 //==========================================================================
5019 UFO_FORCE_INLINE int ufoBufEquCI (uint32_t addr, uint32_t count, const void *buf) {
5020   int res;
5021   if ((count & ((uint32_t)1<<31)) == 0) {
5022     const unsigned char *src = (const unsigned char *)buf;
5023     res = 1;
5024     while (res != 0 && count != 0) {
5025       res = (toUpperU8(*src) == toUpperU8(ufoImgGetU8Ext(addr)));
5026       src += 1; addr += 1u; count -= 1u;
5027     }
5028   } else {
5029     res = 0;
5030   }
5031   return res;
5032 }
5033
5034
5035 //==========================================================================
5036 //
5037 //  ufoClearCondDefines
5038 //
5039 //==========================================================================
5040 static void ufoClearCondDefines (void) {
5041   while (ufoCondDefines) {
5042     UForthCondDefine *df = ufoCondDefines;
5043     ufoCondDefines = df->next;
5044     if (df->name) free(df->name);
5045     free(df);
5046   }
5047 }
5048
5049
5050 //==========================================================================
5051 //
5052 //  ufoHasCondDefine
5053 //
5054 //==========================================================================
5055 int ufoHasCondDefine (const char *name) {
5056   int res = 0;
5057   if (name != NULL && name[0] != 0) {
5058     const size_t nlen = strlen(name);
5059     if (nlen <= 255) {
5060       const uint32_t hash = joaatHashBufCI(name, nlen);
5061       UForthCondDefine *dd = ufoCondDefines;
5062       while (res == 0 && dd != NULL) {
5063         if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
5064           res = ufoStrEquCI(name, dd->name);
5065         }
5066         dd = dd->next;
5067       }
5068     }
5069   }
5070   return res;
5071 }
5072
5073
5074 //==========================================================================
5075 //
5076 //  ufoCondDefine
5077 //
5078 //==========================================================================
5079 void ufoCondDefine (const char *name) {
5080   if (name != NULL && name[0] != 0) {
5081     const size_t nlen = strlen(name);
5082     if (nlen > 255) ufoFatal("conditional define name too long");
5083     const uint32_t hash = joaatHashBufCI(name, nlen);
5084     UForthCondDefine *dd = ufoCondDefines;
5085     int res = 0;
5086     while (res == 0 && dd != NULL) {
5087       if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
5088         res = ufoStrEquCI(name, dd->name);
5089       }
5090       dd = dd->next;
5091     }
5092     if (res == 0) {
5093       // new define
5094       dd = calloc(1, sizeof(UForthCondDefine));
5095       if (dd == NULL) ufoFatal("out of memory for defines");
5096       dd->name = strdup(name);
5097       if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
5098       dd->namelen = (uint32_t)nlen;
5099       dd->hash = hash;
5100       dd->next = ufoCondDefines;
5101       ufoCondDefines = dd;
5102     }
5103   }
5104 }
5105
5106
5107 //==========================================================================
5108 //
5109 //  ufoCondUndef
5110 //
5111 //==========================================================================
5112 void ufoCondUndef (const char *name) {
5113   if (name != NULL && name[0] != 0) {
5114     const size_t nlen = strlen(name);
5115     if (nlen <= 255) {
5116       const uint32_t hash = joaatHashBufCI(name, nlen);
5117       UForthCondDefine *dd = ufoCondDefines;
5118       UForthCondDefine *prev = NULL;
5119       while (dd != NULL) {
5120         if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
5121           if (ufoStrEquCI(name, dd->name)) {
5122             if (prev != NULL) prev->next = dd->next; else ufoCondDefines = dd->next;
5123             free(dd->name);
5124             free(dd);
5125             dd = NULL;
5126           }
5127         }
5128         if (dd != NULL) { prev = dd; dd = dd->next; }
5129       }
5130     }
5131   }
5132 }
5133
5134
5135 // ($DEFINE)
5136 // ( addr count -- )
5137 UFWORD(PAR_DLR_DEFINE) {
5138   uint32_t count = ufoPop();
5139   uint32_t addr = ufoPop();
5140   if (count == 0) ufoFatal("empty define");
5141   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
5142   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
5143   UForthCondDefine *dd;
5144   for (dd = ufoCondDefines; dd != NULL; dd = dd->next) {
5145     if (dd->hash == hash && dd->namelen == count) {
5146       if (ufoBufEquCI(addr, count, dd->name)) return;
5147     }
5148   }
5149   // new define
5150   dd = calloc(1, sizeof(UForthCondDefine));
5151   if (dd == NULL) ufoFatal("out of memory for defines");
5152   dd->name = calloc(1, count + 1u);
5153   if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
5154   for (uint32_t f = 0; f < count; f += 1) {
5155     ((unsigned char *)dd->name)[f] = ufoImgGetU8Ext(addr + f);
5156   }
5157   dd->namelen = count;
5158   dd->hash = hash;
5159   dd->next = ufoCondDefines;
5160   ufoCondDefines = dd;
5161 }
5162
5163 // ($UNDEF)
5164 // ( addr count -- )
5165 UFWORD(PAR_DLR_UNDEF) {
5166   uint32_t count = ufoPop();
5167   uint32_t addr = ufoPop();
5168   if (count == 0) ufoFatal("empty define");
5169   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
5170   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
5171   UForthCondDefine *prev = NULL;
5172   UForthCondDefine *dd;
5173   for (dd = ufoCondDefines; dd != NULL; prev = dd, dd = dd->next) {
5174     if (dd->hash == hash && dd->namelen == count) {
5175       if (ufoBufEquCI(addr, count, dd->name)) {
5176         if (prev == NULL) ufoCondDefines = dd->next; else prev->next = dd->next;
5177         free(dd->name);
5178         free(dd);
5179         return;
5180       }
5181     }
5182   }
5183 }
5184
5185 // ($DEFINED?)
5186 // ( addr count -- bool )
5187 UFWORD(PAR_DLR_DEFINEDQ) {
5188   uint32_t count = ufoPop();
5189   uint32_t addr = ufoPop();
5190   if (count == 0) ufoFatal("empty define");
5191   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
5192   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
5193   int found = 0;
5194   UForthCondDefine *dd = ufoCondDefines;
5195   while (!found && dd != NULL) {
5196     if (dd->hash == hash && dd->namelen == count) {
5197       found = ufoBufEquCI(addr, count, dd->name);
5198     }
5199     dd = dd->next;
5200   }
5201   ufoPushBool(found);
5202 }
5203
5204
5205 // ////////////////////////////////////////////////////////////////////////// //
5206 // error reporting
5207 //
5208
5209 // ERROR
5210 // ( addr count -- )
5211 UFWORD(ERROR) {
5212   uint32_t count = ufoPop();
5213   uint32_t addr = ufoPop();
5214   if (count & (1u<<31)) ufoFatal("invalid error message");
5215   if (count == 0) ufoFatal("some error");
5216   if (count > (uint32_t)sizeof(ufoErrMsgBuf) - 1u) count = (uint32_t)sizeof(ufoErrMsgBuf) - 1u;
5217   for (uint32_t f = 0; f < count; f += 1) {
5218     ufoErrMsgBuf[f] = (char)ufoImgGetU8Ext(addr + f);
5219   }
5220   ufoErrMsgBuf[count] = 0;
5221   ufoFatal("%s", ufoErrMsgBuf);
5222 }
5223
5224 // ////////////////////////////////////////////////////////////////////////// //
5225 // includes
5226 //
5227
5228 static char ufoFNameBuf[4096];
5229
5230
5231 //==========================================================================
5232 //
5233 //  ufoScanIncludeFileName
5234 //
5235 //  `*psys` and `*psoft` must be initialised!
5236 //
5237 //==========================================================================
5238 static void ufoScanIncludeFileName (uint32_t addr, uint32_t count, char *dest, size_t destsz,
5239                                     uint32_t *psys, uint32_t *psoft)
5240 {
5241   uint8_t ch;
5242   uint32_t dpos;
5243   ufo_assert(dest != NULL);
5244   ufo_assert(destsz > 0);
5245
5246   while (count != 0) {
5247     ch = ufoImgGetU8Ext(addr);
5248     if (ch == '!') {
5249       //if (system) ufoFatal("invalid file name (duplicate system mark)");
5250       *psys = 1;
5251     } else if (ch == '?') {
5252       //if (softinclude) ufoFatal("invalid file name (duplicate soft mark)");
5253       *psoft = 1;
5254     } else {
5255       break;
5256     }
5257     do {
5258       addr += 1; count -= 1;
5259       ch = ufoImgGetU8Ext(addr);
5260     } while (ch <= 32 && count != 0);
5261   }
5262
5263   if (count == 0) ufoFatal("empty include file name");
5264   if (count >= destsz) ufoFatal("include file name too long");
5265
5266   dpos = 0;
5267   while (count != 0) {
5268     dest[dpos] = (char)ufoImgGetU8Ext(addr); dpos += 1;
5269     addr += 1; count -= 1;
5270   }
5271   dest[dpos] = 0;
5272 }
5273
5274
5275 // (INCLUDE-DEPTH)
5276 // ( -- depth )
5277 // return number of items in include stack
5278 UFWORD(PAR_INCLUDE_DEPTH) {
5279   ufoPush(ufoFileStackPos);
5280 }
5281
5282 // (INCLUDE-FILE-ID)
5283 // ( isp -- id ) -- isp 0 is current, then 1, etc.
5284 // each include file has unique non-zero id.
5285 UFWORD(PAR_INCLUDE_FILE_ID) {
5286   const uint32_t isp = ufoPop();
5287   if (isp == 0) {
5288     ufoPush(ufoFileId);
5289   } else if (isp <= ufoFileStackPos) {
5290     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
5291     ufoPush(stk->id);
5292   } else {
5293     ufoFatal("invalid include stack index");
5294   }
5295 }
5296
5297 // (INCLUDE-FILE-LINE)
5298 // ( isp -- line )
5299 UFWORD(PAR_INCLUDE_FILE_LINE) {
5300   const uint32_t isp = ufoPop();
5301   if (isp == 0) {
5302     ufoPush(ufoInFileLine);
5303   } else if (isp <= ufoFileStackPos) {
5304     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
5305     ufoPush(stk->fline);
5306   } else {
5307     ufoFatal("invalid include stack index");
5308   }
5309 }
5310
5311 // (INCLUDE-FILE-NAME)
5312 // ( isp -- addr count )
5313 // current file name; at PAD
5314 UFWORD(PAR_INCLUDE_FILE_NAME) {
5315   const uint32_t isp = ufoPop();
5316   const char *fname = NULL;
5317   if (isp == 0) {
5318     fname = ufoInFileName;
5319   } else if (isp <= ufoFileStackPos) {
5320     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
5321     fname = stk->fname;
5322   } else {
5323     ufoFatal("invalid include stack index");
5324   }
5325   UFCALL(PAD);
5326   uint32_t addr = ufoPop();
5327   uint32_t count = 0;
5328   while (fname[count] != 0) {
5329     ufoImgPutU8Ext(addr + count, ((const unsigned char *)fname)[count]);
5330     count += 1;
5331   }
5332   ufoImgPutU8Ext(addr + count, 0);
5333   ufoPush(addr);
5334   ufoPush(count);
5335 }
5336
5337 // (INCLUDE)
5338 // ( addr count soft? system? -- )
5339 UFWORD(PAR_INCLUDE) {
5340   uint32_t system = ufoPop();
5341   uint32_t softinclude = ufoPop();
5342   uint32_t count = ufoPop();
5343   uint32_t addr = ufoPop();
5344
5345   if (ufoMode == UFO_MODE_MACRO) ufoFatal("macros cannot include files");
5346
5347   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid include name");
5348
5349   ufoScanIncludeFileName(addr, count, ufoFNameBuf, sizeof(ufoFNameBuf),
5350                          &system, &softinclude);
5351
5352   char *ffn = ufoCreateIncludeName(ufoFNameBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
5353   #ifdef WIN32
5354   FILE *fl = fopen(ffn, "rb");
5355   #else
5356   FILE *fl = fopen(ffn, "r");
5357   #endif
5358   if (!fl) {
5359     if (softinclude) { free(ffn); return; }
5360     ufoFatal("include file '%s' not found", ffn);
5361   }
5362   #ifdef UFO_DEBUG_INCLUDE
5363   fprintf(stderr, "INC-PUSH: new fname: %s\n", ffn);
5364   #endif
5365   ufoPushInFile();
5366   ufoInFile = fl;
5367   ufoInFileLine = 0;
5368   ufoSetInFileNameReuse(ffn);
5369   ufoFileId = ufoLastUsedFileId;
5370   setLastIncPath(ufoInFileName, system);
5371   // trigger next line loading
5372   UFCALL(REFILL);
5373   if (!ufoPop()) ufoFatal("(INCLUDE) internal error");
5374 }
5375
5376 // $INCLUDE "str"
5377 UFWORD(DLR_INCLUDE_IMM) {
5378   int soft = 0, system = 0;
5379   // parse include filename
5380   //UFCALL(PARSE_SKIP_BLANKS);
5381   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
5382   uint8_t ch = ufoTibPeekCh();
5383   if (ch == '"') {
5384     ufoTibSkipCh(); // skip quote
5385     ufoPush(34);
5386   } else if (ch == '<') {
5387     ufoTibSkipCh(); // skip quote
5388     ufoPush(62);
5389     system = 1;
5390   } else {
5391     ufoFatal("expected quoted string");
5392   }
5393   UFCALL(PARSE);
5394   if (!ufoPop()) ufoFatal("file name expected");
5395   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
5396   if (ufoTibPeekCh() != 0) {
5397     ufoFatal("$INCLUDE doesn't accept extra args yet");
5398   }
5399   // ( addr count soft? system? -- )
5400   ufoPushBool(soft); ufoPushBool(system); UFCALL(PAR_INCLUDE);
5401 }
5402
5403
5404 //==========================================================================
5405 //
5406 //  ufoCreateFileGuard
5407 //
5408 //==========================================================================
5409 static const char *ufoCreateFileGuard (const char *fname) {
5410   if (fname == NULL || fname[0] == 0) return NULL;
5411   char *rp = ufoRealPath(fname);
5412   if (rp == NULL) return NULL;
5413   #ifdef WIN32
5414   for (char *s = rp; *s; s += 1) if (*s == '\\') *s = '/';
5415   #endif
5416   // hash the buffer; extract file name; create string with path len, file name, and hash
5417   const size_t orgplen = strlen(rp);
5418   const uint32_t phash = joaatHashBuf(rp, orgplen, 0);
5419   size_t plen = orgplen;
5420   while (plen != 0 && rp[plen - 1u] != '/') plen -= 1;
5421   snprintf(ufoRealPathHashBuf, sizeof(ufoRealPathHashBuf),
5422            "__INCLUDE_GUARD_%08X_%08X_%s__", phash, (uint32_t)orgplen, rp + plen);
5423   return ufoRealPathHashBuf;
5424 }
5425
5426
5427 // $INCLUDE-ONCE "str"
5428 // includes file only once; unreliable on shitdoze, i believe
5429 UFWORD(DLR_INCLUDE_ONCE_IMM) {
5430   uint32_t softinclude = 0, system = 0;
5431   // parse include filename
5432   //UFCALL(PARSE_SKIP_BLANKS);
5433   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
5434   uint8_t ch = ufoTibPeekCh();
5435   if (ch == '"') {
5436     ufoTibSkipCh(); // skip quote
5437     ufoPush(34);
5438   } else if (ch == '<') {
5439     ufoTibSkipCh(); // skip quote
5440     ufoPush(62);
5441     system = 1;
5442   } else {
5443     ufoFatal("expected quoted string");
5444   }
5445   UFCALL(PARSE);
5446   if (!ufoPop()) ufoFatal("file name expected");
5447   const uint32_t count = ufoPop();
5448   const uint32_t addr = ufoPop();
5449   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
5450   if (ufoTibPeekCh() != 0) {
5451     ufoFatal("$REQUIRE doesn't accept extra args yet");
5452   }
5453   ufoScanIncludeFileName(addr, count, ufoRealPathHashBuf, sizeof(ufoRealPathHashBuf),
5454                          &system, &softinclude);
5455   char *incfname = ufoCreateIncludeName(ufoRealPathHashBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
5456   if (incfname == NULL) ufoFatal("cannot resolve include file '%s'", ufoRealPathHashBuf);
5457   //fprintf(stderr, "?:%d;!:%d;%s|%s\n", softinclude, system, ufoRealPathHashBuf, incfname);
5458   // this will overwrite `ufoRealPathHashBuf`
5459   const char *guard = ufoCreateFileGuard(incfname);
5460   free(incfname);
5461   if (guard == NULL) {
5462     if (!softinclude) ufoFatal("cannot include file '%s'", ufoRealPathHashBuf);
5463     return;
5464   }
5465   #if 0
5466   fprintf(stderr, "GUARD: <%s>\n", guard);
5467   #endif
5468   // now check for the guard
5469   const uint32_t glen = (uint32_t)strlen(guard);
5470   const uint32_t ghash = joaatHashBuf(guard, glen, 0);
5471   UForthCondDefine *dd;
5472   for (dd = ufoCondDefines; dd != NULL; dd = dd->next) {
5473     if (dd->hash == ghash && dd->namelen == glen && strcmp(guard, dd->name) == 0) {
5474       // nothing to do: already included
5475       return;
5476     }
5477   }
5478   // add guard
5479   dd = calloc(1, sizeof(UForthCondDefine));
5480   if (dd == NULL) ufoFatal("out of memory for defines");
5481   dd->name = calloc(1, glen + 1u);
5482   if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
5483   strcpy(dd->name, guard);
5484   dd->namelen = glen;
5485   dd->hash = ghash;
5486   dd->next = ufoCondDefines;
5487   ufoCondDefines = dd;
5488   // ( addr count soft? system? -- )
5489   ufoPush(addr); ufoPush(count); ufoPushBool(softinclude); ufoPushBool(system);
5490   UFCALL(PAR_INCLUDE);
5491 }
5492
5493
5494 // ////////////////////////////////////////////////////////////////////////// //
5495 // handles
5496 //
5497
5498 // HANDLE:NEW
5499 // ( typeid -- hx )
5500 UFWORD(PAR_NEW_HANDLE) {
5501   const uint32_t typeid = ufoPop();
5502   if (typeid == UFO_HANDLE_FREE) ufoFatal("invalid handle typeid");
5503   UfoHandle *hh = ufoAllocHandle(typeid);
5504   ufoPush(hh->ufoHandle);
5505 }
5506
5507 // HANDLE:FREE
5508 // ( hx -- )
5509 UFWORD(PAR_FREE_HANDLE) {
5510   const uint32_t hx = ufoPop();
5511   if (hx != 0) {
5512     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("trying to free something that is not a handle");
5513     UfoHandle *hh = ufoGetHandle(hx);
5514     if (hh == NULL) ufoFatal("trying to free invalid handle");
5515     ufoFreeHandle(hh);
5516   }
5517 }
5518
5519 // HANDLE:TYPEID@
5520 // ( hx -- typeid )
5521 UFWORD(PAR_HANDLE_GET_TYPEID) {
5522   const uint32_t hx = ufoPop();
5523   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5524   UfoHandle *hh = ufoGetHandle(hx);
5525   if (hh == NULL) ufoFatal("invalid handle");
5526   ufoPush(hh->typeid);
5527 }
5528
5529 // HANDLE:TYPEID!
5530 // ( typeid hx -- )
5531 UFWORD(PAR_HANDLE_SET_TYPEID) {
5532   const uint32_t hx = ufoPop();
5533   const uint32_t typeid = ufoPop();
5534   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5535   if (typeid == UFO_HANDLE_FREE) ufoFatal("invalid handle typeid");
5536   UfoHandle *hh = ufoGetHandle(hx);
5537   if (hh == NULL) ufoFatal("invalid handle");
5538   hh->typeid = typeid;
5539 }
5540
5541 // HANDLE:SIZE@
5542 // ( hx -- size )
5543 UFWORD(PAR_HANDLE_GET_SIZE) {
5544   const uint32_t hx = ufoPop();
5545   if (hx != 0) {
5546     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5547     UfoHandle *hh = ufoGetHandle(hx);
5548     if (hh == NULL) ufoFatal("invalid handle");
5549     ufoPush(hh->size);
5550   } else {
5551     ufoPush(0);
5552   }
5553 }
5554
5555 // HANDLE:SIZE!
5556 // ( size hx -- )
5557 UFWORD(PAR_HANDLE_SET_SIZE) {
5558   const uint32_t hx = ufoPop();
5559   const uint32_t size = ufoPop();
5560   if (size > 0x04000000) ufoFatal("invalid handle size");
5561   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5562   UfoHandle *hh = ufoGetHandle(hx);
5563   if (hh == NULL) ufoFatal("invalid handle");
5564   if (hh->size != size) {
5565     if (size == 0) {
5566       free(hh->data);
5567       hh->data = NULL;
5568     } else {
5569       uint8_t *nx = realloc(hh->data, size * sizeof(hh->data[0]));
5570       if (nx == NULL) ufoFatal("out of memory for handle of size %u", size);
5571       hh->data = nx;
5572       if (size > hh->size) memset(hh->data, 0, size - hh->size);
5573     }
5574     hh->size = size;
5575     if (hh->used > size) hh->used = size;
5576   }
5577 }
5578
5579 // HANDLE:USED@
5580 // ( hx -- used )
5581 UFWORD(PAR_HANDLE_GET_USED) {
5582   const uint32_t hx = ufoPop();
5583   if (hx != 0) {
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->used);
5588   } else {
5589     ufoPush(0);
5590   }
5591 }
5592
5593 // HANDLE:USED!
5594 // ( size hx -- )
5595 UFWORD(PAR_HANDLE_SET_USED) {
5596   const uint32_t hx = ufoPop();
5597   const uint32_t used = ufoPop();
5598   if (used > 0x04000000) ufoFatal("invalid handle used");
5599   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
5600   UfoHandle *hh = ufoGetHandle(hx);
5601   if (hh == NULL) ufoFatal("invalid handle");
5602   if (used > hh->size) ufoFatal("handle used %u out of range (%u)", used, hh->size);
5603   hh->used = used;
5604 }
5605
5606 #define POP_PREPARE_HANDLE() \
5607   const uint32_t hx = ufoPop(); \
5608   uint32_t idx = ufoPop(); \
5609   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle"); \
5610   if (idx > 0x1fffffffU - UFO_ADDR_HANDLE_OFS_MASK) ufoFatal("handle index %u out of range", idx); \
5611   idx += (hx & UFO_ADDR_HANDLE_OFS_MASK); \
5612   UfoHandle *hh = ufoGetHandle(hx); \
5613   if (hh == NULL) ufoFatal("invalid handle")
5614
5615 // HANDLE:C@
5616 // ( idx hx -- value )
5617 UFWORD(PAR_HANDLE_LOAD_BYTE) {
5618   POP_PREPARE_HANDLE();
5619   if (idx >= hh->size) ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5620   ufoPush(hh->data[idx]);
5621 }
5622
5623 // HANDLE:W@
5624 // ( idx hx -- value )
5625 UFWORD(PAR_HANDLE_LOAD_WORD) {
5626   POP_PREPARE_HANDLE();
5627   if (idx >= hh->size || hh->size - idx < 2u) {
5628     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5629   }
5630   #ifdef UFO_FAST_MEM_ACCESS
5631   ufoPush(*(const uint16_t *)(hh->data + idx));
5632   #else
5633   uint32_t res = hh->data[idx];
5634   res |= hh->data[idx + 1u] << 8;
5635   ufoPush(res);
5636   #endif
5637 }
5638
5639 // HANDLE:@
5640 // ( idx hx -- value )
5641 UFWORD(PAR_HANDLE_LOAD_CELL) {
5642   POP_PREPARE_HANDLE();
5643   if (idx >= hh->size || hh->size - idx < 4u) {
5644     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5645   }
5646   #ifdef UFO_FAST_MEM_ACCESS
5647   ufoPush(*(const uint32_t *)(hh->data + idx));
5648   #else
5649   uint32_t res = hh->data[idx];
5650   res |= hh->data[idx + 1u] << 8;
5651   res |= hh->data[idx + 2u] << 16;
5652   res |= hh->data[idx + 3u] << 24;
5653   ufoPush(res);
5654   #endif
5655 }
5656
5657 // HANDLE:C!
5658 // ( value idx hx -- value )
5659 UFWORD(PAR_HANDLE_STORE_BYTE) {
5660   POP_PREPARE_HANDLE();
5661   const uint32_t value = ufoPop();
5662   if (idx >= hh->size) ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5663   hh->data[idx] = value;
5664 }
5665
5666 // HANDLE:W!
5667 // ( value idx hx -- )
5668 UFWORD(PAR_HANDLE_STORE_WORD) {
5669   POP_PREPARE_HANDLE();
5670   const uint32_t value = ufoPop();
5671   if (idx >= hh->size || hh->size - idx < 2u) {
5672     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5673   }
5674   #ifdef UFO_FAST_MEM_ACCESS
5675   *(uint16_t *)(hh->data + idx) = (uint16_t)value;
5676   #else
5677   hh->data[idx] = (uint8_t)value;
5678   hh->data[idx + 1u] = (uint8_t)(value >> 8);
5679   #endif
5680 }
5681
5682 // HANDLE:!
5683 // ( value idx hx -- )
5684 UFWORD(PAR_HANDLE_STORE_CELL) {
5685   POP_PREPARE_HANDLE();
5686   const uint32_t value = ufoPop();
5687   if (idx >= hh->size || hh->size - idx < 4u) {
5688     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
5689   }
5690   #ifdef UFO_FAST_MEM_ACCESS
5691   *(uint32_t *)(hh->data + idx) = value;
5692   #else
5693   hh->data[idx] = (uint8_t)value;
5694   hh->data[idx + 1u] = (uint8_t)(value >> 8);
5695   hh->data[idx + 2u] = (uint8_t)(value >> 16);
5696   hh->data[idx + 3u] = (uint8_t)(value >> 24);
5697   #endif
5698 }
5699
5700
5701 // HANDLE:LOAD-FILE
5702 // ( addr count -- stx / FALSE )
5703 UFWORD(PAR_HANDLE_LOAD_FILE) {
5704   uint32_t count = ufoPop();
5705   uint32_t addr = ufoPop();
5706
5707   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid file name");
5708
5709   uint8_t *dest = (uint8_t *)ufoFNameBuf;
5710   while (count != 0 && dest < (uint8_t *)ufoFNameBuf + sizeof(ufoFNameBuf)) {
5711     uint8_t ch = ufoImgGetU8Ext(addr);
5712     *dest = ch;
5713     dest += 1u; addr += 1u; count -= 1u;
5714   }
5715   if (dest == (uint8_t *)ufoFNameBuf + sizeof(ufoFNameBuf)) ufoFatal("file name too long");
5716   *dest = 0;
5717
5718   if (*ufoFNameBuf == 0) ufoFatal("empty file name");
5719
5720   char *ffn = ufoCreateIncludeName(ufoFNameBuf, 0/*system*/, ufoLastIncPath);
5721   #ifdef WIN32
5722   FILE *fl = fopen(ffn, "rb");
5723   #else
5724   FILE *fl = fopen(ffn, "r");
5725   #endif
5726   if (!fl) {
5727     free(ffn);
5728     ufoPush(0);
5729     return;
5730   }
5731
5732   if (fseek(fl, 0, SEEK_END) != 0) {
5733     fclose(fl);
5734     ufoFatal("seek error in file '%s'", ffn);
5735   }
5736
5737   long sz = ftell(fl);
5738   if (sz < 0 || sz >= 1024 * 1024 * 64) {
5739     fclose(fl);
5740     ufoFatal("tell error in file '%s' (or too big)", ffn);
5741   }
5742
5743   if (fseek(fl, 0, SEEK_SET) != 0) {
5744     fclose(fl);
5745     ufoFatal("seek error in file '%s'", ffn);
5746   }
5747
5748   UfoHandle *hh = ufoAllocHandle(0);
5749   if (sz != 0) {
5750     hh->data = malloc((uint32_t)sz);
5751     if (hh->data == NULL) {
5752       fclose(fl);
5753       ufoFatal("out of memory for file '%s'", ffn);
5754     }
5755     hh->size = (uint32_t)sz;
5756     if (fread(hh->data, (uint32_t)sz, 1, fl) != 1) {
5757       fclose(fl);
5758       ufoFatal("error reading file '%s'", ffn);
5759     }
5760     fclose(fl);
5761   }
5762
5763   free(ffn);
5764   ufoPush(hh->ufoHandle);
5765 }
5766
5767
5768 // ////////////////////////////////////////////////////////////////////////// //
5769 // utils
5770 //
5771
5772 // DEBUG:(DECOMPILE-CFA)
5773 // ( cfa -- )
5774 UFWORD(DEBUG_DECOMPILE_CFA) {
5775   const uint32_t cfa = ufoPop();
5776   ufoFlushOutput();
5777   ufoDecompileWord(cfa);
5778 }
5779
5780 // DEBUG:(DECOMPILE-MEM)
5781 // ( addr-start addr-end -- )
5782 UFWORD(DEBUG_DECOMPILE_MEM) {
5783   const uint32_t end = ufoPop();
5784   const uint32_t start = ufoPop();
5785   ufoFlushOutput();
5786   ufoDecompilePart(start, end, 0);
5787 }
5788
5789 // GET-MSECS
5790 // ( -- u32 )
5791 UFWORD(GET_MSECS) {
5792   ufoPush((uint32_t)ufo_get_msecs());
5793 }
5794
5795 // this is called by INTERPRET when it is out of input stream
5796 UFWORD(UFO_INTERPRET_FINISHED_ACTION) {
5797   ufoVMStop = 1;
5798 }
5799
5800 // MTASK:NEW-STATE
5801 // ( cfa -- stid )
5802 UFWORD(MT_NEW_STATE) {
5803   UfoState *st = ufoNewState();
5804   ufoInitStateUserVars(st, ufoPop());
5805   ufoPush(st->id);
5806 }
5807
5808 // MTASK:FREE-STATE
5809 // ( stid -- )
5810 UFWORD(MT_FREE_STATE) {
5811   UfoState *st = ufoFindState(ufoPop());
5812   if (st == NULL) ufoFatal("cannot free unknown state");
5813   if (st == ufoCurrState) ufoFatal("cannot free current state");
5814   ufoFreeState(st);
5815 }
5816
5817 // MTASK:STATE-NAME@
5818 // ( stid -- addr count )
5819 // to PAD
5820 UFWORD(MT_GET_STATE_NAME) {
5821   UfoState *st = ufoFindState(ufoPop());
5822   if (st == NULL) ufoFatal("unknown state");
5823   UFCALL(PAD);
5824   uint32_t addr = ufoPop();
5825   uint32_t count = 0;
5826   while (st->name[count] != 0) {
5827     ufoImgPutU8Ext(addr + count, ((const unsigned char *)st->name)[count]);
5828     count += 1u;
5829   }
5830   ufoImgPutU8Ext(addr + count, 0);
5831   ufoPush(addr);
5832   ufoPush(count);
5833 }
5834
5835 // MTASK:STATE-NAME!
5836 // ( addr count stid -- )
5837 UFWORD(MT_SET_STATE_NAME) {
5838   UfoState *st = ufoFindState(ufoPop());
5839   if (st == NULL) ufoFatal("unknown state");
5840   uint32_t count = ufoPop();
5841   uint32_t addr = ufoPop();
5842   if ((count & ((uint32_t)1 << 31)) == 0) {
5843     if (count > UFO_MAX_TASK_NAME) ufoFatal("task name too long");
5844     for (uint32_t f = 0; f < count; f += 1u) {
5845       ((unsigned char *)st->name)[f] = ufoImgGetU8Ext(addr + f);
5846     }
5847     st->name[count] = 0;
5848   }
5849 }
5850
5851 // MTASK:STATE-FIRST
5852 // ( -- stid )
5853 UFWORD(MT_STATE_FIRST) {
5854   uint32_t fidx = 0;
5855   while (fidx != (uint32_t)(UFO_MAX_STATES/32) && ufoStateUsedBitmap[fidx] == 0) fidx += 1u;
5856   // there should be at least one allocated state
5857   ufo_assert(fidx != (uint32_t)(UFO_MAX_STATES/32));
5858   uint32_t bmp = ufoStateUsedBitmap[fidx];
5859   fidx *= 32u;
5860   while ((bmp & 0x01) == 0) { fidx += 1u; bmp >>= 1; }
5861   ufoPush(fidx + 1u);
5862 }
5863
5864 // MTASK:STATE-NEXT
5865 // ( stid -- stid / 0 )
5866 UFWORD(MT_STATE_NEXT) {
5867   uint32_t stid = ufoPop();
5868   if (stid != 0 && stid < (uint32_t)(UFO_MAX_STATES/32)) {
5869     // it is already incremented for us, yay!
5870     uint32_t fidx = stid / 32u;
5871     uint8_t fofs = stid & 0x1f;
5872     while (fidx < (uint32_t)(UFO_MAX_STATES/32)) {
5873       const uint32_t bmp = ufoStateUsedBitmap[fidx];
5874       if (bmp != 0) {
5875         while (fofs != 32u) {
5876           if ((bmp & ((uint32_t)1 << (fofs & 0x1f))) == 0) fofs += 1u;
5877         }
5878         if (fofs != 32u) {
5879           ufoPush(fidx * 32u + fofs + 1u);
5880           return; // sorry!
5881         }
5882       }
5883       fidx += 1u; fofs = 0;
5884     }
5885   }
5886   ufoPush(0);
5887 }
5888
5889
5890 // MTASK:YIELD-TO
5891 // ( ... argc stid -- )
5892 UFWORD(MT_YIELD_TO) {
5893   UfoState *st = ufoFindState(ufoPop());
5894   if (st == NULL) ufoFatal("cannot yield to unknown state");
5895   //if (st == ufoDebuggerState) ufoFatal("cannot yield to debugger"); // why not?
5896   const uint32_t argc = ufoPop();
5897   if (argc > 256) ufoFatal("too many YIELD-TO arguments");
5898   UfoState *curst = ufoCurrState;
5899   if (st != ufoCurrState) {
5900     for (uint32_t f = 0; f < argc; f += 1) {
5901       ufoCurrState = curst;
5902       const uint32_t n = ufoPop();
5903       ufoCurrState = st;
5904       ufoPush(n);
5905     }
5906     ufoCurrState = curst; // we need to use API call to switch states
5907   }
5908   ufoSwitchToState(st); // always use API call for this!
5909   ufoPush(argc);
5910   ufoPush(curst->id);
5911 }
5912
5913 // MTASK:SET-SELF-AS-DEBUGGER
5914 // ( -- )
5915 UFWORD(MT_SET_SELF_AS_DEBUGGER) {
5916   ufoDebuggerState = ufoCurrState;
5917 }
5918
5919 // DEBUG:(BP)
5920 // ( -- )
5921 // debugger task receives debugge stid on the data stack, and -1 as argc.
5922 // i.e. debugger stask is: ( -1 old-stid )
5923 UFWORD(MT_DEBUGGER_BP) {
5924   if (ufoDebuggerState != NULL && ufoCurrState != ufoDebuggerState && ufoIsGoodTTY()) {
5925     UfoState *st = ufoCurrState;
5926     ufoSwitchToState(ufoDebuggerState); // always use API call for this!
5927     ufoPush(-1);
5928     ufoPush(st->id);
5929     ufoSingleStep = 0;
5930   } else {
5931     UFCALL(UFO_BACKTRACE);
5932   }
5933 }
5934
5935 // MTASK:DEBUGGER-RESUME
5936 // ( stid -- )
5937 UFWORD(MT_RESUME_DEBUGEE) {
5938   if (ufoCurrState != ufoDebuggerState) ufoFatal("cannot resume from non-debugger");
5939   UfoState *st = ufoFindState(ufoPop());
5940   if (st == NULL) ufoFatal("cannot yield to unknown state");
5941   if (st == ufoCurrState) ufoFatal("cannot resume into debugger itself");
5942   ufoSwitchToState(st); // always use API call for this!
5943   ufoSingleStep = 0;
5944 }
5945
5946 // MTASK:DEBUGGER-SINGLE-STEP
5947 // ( stid -- )
5948 UFWORD(MT_SINGLE_STEP_DEBUGEE) {
5949   if (ufoCurrState != ufoDebuggerState) ufoFatal("cannot resume from non-debugger");
5950   UfoState *st = ufoFindState(ufoPop());
5951   if (st == NULL) ufoFatal("cannot yield to unknown state");
5952   if (st == ufoCurrState) ufoFatal("cannot resume into debugger itself");
5953   ufoSwitchToState(st); // always use API call for this!
5954   ufoSingleStep = 2; // it will be decremented after returning from this word
5955 }
5956
5957 // MTASK:STATE-IP@
5958 // ( stid -- ip )
5959 UFWORD(MT_STATE_IP_GET) {
5960   UfoState *st = ufoFindState(ufoPop());
5961   if (st == NULL) ufoFatal("unknown state");
5962   ufoPush(st->IP);
5963 }
5964
5965 // MTASK:STATE-IP!
5966 // ( ip stid -- )
5967 UFWORD(MT_STATE_IP_SET) {
5968   UfoState *st = ufoFindState(ufoPop());
5969   if (st == NULL) ufoFatal("unknown state");
5970   st->IP = ufoPop();
5971 }
5972
5973 // MTASK:STATE-A>
5974 // ( stid -- ip )
5975 UFWORD(MT_STATE_REGA_GET) {
5976   UfoState *st = ufoFindState(ufoPop());
5977   if (st == NULL) ufoFatal("unknown state");
5978   ufoPush(st->regA);
5979 }
5980
5981 // MTASK:STATE->A
5982 // ( ip stid -- )
5983 UFWORD(MT_STATE_REGA_SET) {
5984   UfoState *st = ufoFindState(ufoPop());
5985   if (st == NULL) ufoFatal("unknown state");
5986   st->regA = ufoPop();
5987 }
5988
5989 // MTASK:STATE-USER@
5990 // ( addr stid -- value )
5991 UFWORD(MT_STATE_USER_GET) {
5992   UfoState *st = ufoFindState(ufoPop());
5993   if (st == NULL) ufoFatal("unknown state");
5994   const uint32_t addr = ufoPop();
5995   if ((addr & UFO_ADDR_TEMP_BIT) != 0 && (addr & UFO_ADDR_TEMP_MASK) + 3u < st->imageTempSize) {
5996     uint32_t v = *(const uint32_t *)((const uint8_t *)st->imageTemp + (addr & UFO_ADDR_TEMP_MASK));
5997     ufoPush(v);
5998   } else {
5999     ufoFatal("invalid user area address");
6000   }
6001 }
6002
6003 // MTASK:STATE-USER!
6004 // ( value addr stid -- )
6005 UFWORD(MT_STATE_USER_SET) {
6006   UfoState *st = ufoFindState(ufoPop());
6007   if (st == NULL) ufoFatal("unknown state");
6008   const uint32_t addr = ufoPop();
6009   const uint32_t value = ufoPop();
6010   if ((addr & UFO_ADDR_TEMP_BIT) != 0 && (addr & UFO_ADDR_TEMP_MASK) + 3u < st->imageTempSize) {
6011     *(uint32_t *)((const uint8_t *)st->imageTemp + (addr & UFO_ADDR_TEMP_MASK)) = value;
6012   } else {
6013     ufoFatal("invalid user area address");
6014   }
6015 }
6016
6017 // MTASK:STATE-RPOPCFA@
6018 // ( -- flag )
6019 UFWORD(MT_STATE_RPOPCFA_GET) {
6020   UfoState *st = ufoFindState(ufoPop());
6021   if (st == NULL) ufoFatal("unknown state");
6022   ufoPush(st->vmRPopCFA);
6023 }
6024
6025 // MTASK:STATE-RPOPCFA!
6026 // ( flag -- )
6027 UFWORD(MT_STATE_RPOPCFA_SET) {
6028   UfoState *st = ufoFindState(ufoPop());
6029   if (st == NULL) ufoFatal("unknown state");
6030   st->vmRPopCFA = ufoPop();
6031 }
6032
6033 // MTASK:ACTIVE-STATE
6034 // ( -- stid )
6035 UFWORD(MT_ACTIVE_STATE) {
6036   ufoPush(ufoCurrState->id);
6037 }
6038
6039 // MTASK:YIELDED-FROM
6040 // ( -- stid / 0 )
6041 UFWORD(MT_YIELDED_FROM) {
6042   if (ufoYieldedState != NULL) {
6043     ufoPush(ufoYieldedState->id);
6044   } else {
6045     ufoPush(0);
6046   }
6047 }
6048
6049 // MTASK:STATE-SP@
6050 // ( stid -- depth )
6051 UFWORD(MT_DSTACK_DEPTH_GET) {
6052   UfoState *st = ufoFindState(ufoPop());
6053   if (st == NULL) ufoFatal("unknown state");
6054   ufoPush(st->SP);
6055 }
6056
6057 // MTASK:STATE-RP@
6058 // ( stid -- depth )
6059 UFWORD(MT_RSTACK_DEPTH_GET) {
6060   UfoState *st = ufoFindState(ufoPop());
6061   if (st == NULL) ufoFatal("unknown state");
6062   ufoPush(st->RP - st->RPTop);
6063 }
6064
6065 // MTASK:STATE-LP@
6066 // ( stid -- lp )
6067 UFWORD(MT_LP_GET) {
6068   UfoState *st = ufoFindState(ufoPop());
6069   if (st == NULL) ufoFatal("unknown state");
6070   ufoPush(st->LP);
6071 }
6072
6073 // MTASK:STATE-LBP@
6074 // ( stid -- lbp )
6075 UFWORD(MT_LBP_GET) {
6076   UfoState *st = ufoFindState(ufoPop());
6077   if (st == NULL) ufoFatal("unknown state");
6078   ufoPush(st->LBP);
6079 }
6080
6081 // MTASK:STATE-SP!
6082 // ( depth stid -- )
6083 UFWORD(MT_DSTACK_DEPTH_SET) {
6084   UfoState *st = ufoFindState(ufoPop());
6085   if (st == NULL) ufoFatal("unknown state");
6086   const uint32_t idx = ufoPop();
6087   if (idx >= UFO_DSTACK_SIZE) ufoFatal("invalid stack index %u (%u)", idx, UFO_DSTACK_SIZE);
6088   st->SP = idx;
6089 }
6090
6091 // MTASK:STATE-RP!
6092 // ( depth stid -- )
6093 UFWORD(MT_RSTACK_DEPTH_SET) {
6094   UfoState *st = ufoFindState(ufoPop());
6095   if (st == NULL) ufoFatal("unknown state");
6096   const uint32_t idx = ufoPop();
6097   const uint32_t left = UFO_RSTACK_SIZE - st->RPTop;
6098   if (idx >= left) ufoFatal("invalid rstack index %u (%u)", idx, left);
6099   st->RP = st->RPTop + idx;
6100 }
6101
6102 // MTASK:STATE-LP!
6103 // ( lp stid -- )
6104 UFWORD(MT_LP_SET) {
6105   UfoState *st = ufoFindState(ufoPop());
6106   if (st == NULL) ufoFatal("unknown state");
6107   st->LP = ufoPop();
6108 }
6109
6110 // MTASK:STATE-LBP!
6111 // ( lbp stid -- )
6112 UFWORD(MT_LBP_SET) {
6113   UfoState *st = ufoFindState(ufoPop());
6114   if (st == NULL) ufoFatal("unknown state");
6115   st->LBP = ufoPop();
6116 }
6117
6118 // MTASK:STATE-DS@
6119 // ( idx stid -- value )
6120 UFWORD(MT_DSTACK_LOAD) {
6121   UfoState *st = ufoFindState(ufoPop());
6122   if (st == NULL) ufoFatal("unknown state");
6123   const uint32_t idx = ufoPop();
6124   if (idx >= st->SP) ufoFatal("invalid stack index %u (%u)", idx, st->SP);
6125   ufoPush(st->dStack[st->SP - idx - 1u]);
6126 }
6127
6128 // MTASK:STATE-RS@
6129 // ( idx stid -- value )
6130 UFWORD(MT_RSTACK_LOAD) {
6131   UfoState *st = ufoFindState(ufoPop());
6132   if (st == NULL) ufoFatal("unknown state");
6133   const uint32_t idx = ufoPop();
6134   if (idx >= st->RP - st->RPTop) ufoFatal("invalid stack index %u (%u)", idx, st->RP - st->RPTop);
6135   ufoPush(st->dStack[st->RP - idx - 1u]);
6136 }
6137
6138 // MTASK:STATE-LS@
6139 // ( idx stid -- value )
6140 UFWORD(MT_LSTACK_LOAD) {
6141   UfoState *st = ufoFindState(ufoPop());
6142   if (st == NULL) ufoFatal("unknown state");
6143   const uint32_t idx = ufoPop();
6144   if (idx >= st->LP) ufoFatal("invalid lstack index %u (%u)", idx, st->LP);
6145   ufoPush(st->lStack[st->LP - idx - 1u]);
6146 }
6147
6148 // MTASK:STATE-DS!
6149 // ( value idx stid -- )
6150 UFWORD(MT_DSTACK_STORE) {
6151   UfoState *st = ufoFindState(ufoPop());
6152   if (st == NULL) ufoFatal("unknown state");
6153   const uint32_t idx = ufoPop();
6154   const uint32_t value = ufoPop();
6155   if (idx >= st->SP) ufoFatal("invalid stack index %u (%u)", idx, st->SP);
6156   st->dStack[st->SP - idx - 1u] = value;
6157 }
6158
6159 // MTASK:STATE-RS!
6160 // ( value idx stid -- )
6161 UFWORD(MT_RSTACK_STORE) {
6162   UfoState *st = ufoFindState(ufoPop());
6163   if (st == NULL) ufoFatal("unknown state");
6164   const uint32_t idx = ufoPop();
6165   const uint32_t value = ufoPop();
6166   if (idx >= st->RP - st->RPTop) ufoFatal("invalid stack index %u (%u)", idx, st->RP - st->RPTop);
6167   st->dStack[st->RP - idx - 1u] = value;
6168 }
6169
6170 // MTASK:STATE-LS!
6171 // ( value idx stid -- )
6172 UFWORD(MT_LSTACK_STORE) {
6173   UfoState *st = ufoFindState(ufoPop());
6174   if (st == NULL) ufoFatal("unknown state");
6175   const uint32_t idx = ufoPop();
6176   const uint32_t value = ufoPop();
6177   if (idx >= st->LP) ufoFatal("invalid stack index %u (%u)", idx, st->LP);
6178   st->dStack[st->LP - idx - 1u] = value;
6179 }
6180
6181
6182 #include "urforth_tty.c"
6183
6184
6185 // ////////////////////////////////////////////////////////////////////////// //
6186 // "FILES" words
6187 //
6188
6189 static unsigned char ufoFileIOBuffer[4096];
6190
6191
6192 //==========================================================================
6193 //
6194 //  ufoPopFileName
6195 //
6196 //==========================================================================
6197 static char *ufoPopFileName (void) {
6198   uint32_t count = ufoPop();
6199   uint32_t addr = ufoPop();
6200
6201   if ((count & 0x80000000U) != 0) ufoFatal("invalid file name");
6202   if (count == 0) ufoFatal("empty file name");
6203   if (count > (uint32_t)sizeof(ufoFNameBuf) - 1u) ufoFatal("file name too long");
6204
6205   unsigned char *dest = (unsigned char *)ufoFNameBuf;
6206   while (count != 0) {
6207     *dest = ufoImgGetU8Ext(addr);
6208     dest += 1u; addr += 1u; count -= 1u;
6209   }
6210   *dest = 0;
6211
6212   return ufoFNameBuf;
6213 }
6214
6215 // FILES:ERRNO
6216 // ( -- errno )
6217 UFWORD(FILES_ERRNO) {
6218   ufoPush((uint32_t)errno);
6219 }
6220
6221 // FILES:UNLINK
6222 // ( addr count -- success? )
6223 UFWORD(FILES_UNLINK) {
6224   const char *fname = ufoPopFileName();
6225   ufoPushBool(unlink(fname) == 0);
6226 }
6227
6228 // FILES:OPEN-R/O
6229 // ( addr count -- handle TRUE / FALSE )
6230 UFWORD(FILES_OPEN_RO) {
6231   const char *fname = ufoPopFileName();
6232   const int fd = open(fname, O_RDONLY);
6233   if (fd >= 0) {
6234     ufoPush((uint32_t)fd);
6235     ufoPushBool(1);
6236   } else {
6237     ufoPushBool(0);
6238   }
6239 }
6240
6241 // FILES:OPEN-R/W
6242 // ( addr count -- handle TRUE / FALSE )
6243 UFWORD(FILES_OPEN_RW) {
6244   const char *fname = ufoPopFileName();
6245   const int fd = open(fname, O_RDWR);
6246   if (fd >= 0) {
6247     ufoPush((uint32_t)fd);
6248     ufoPushBool(1);
6249   } else {
6250     ufoPushBool(0);
6251   }
6252 }
6253
6254 // FILES:CREATE
6255 // ( addr count -- handle TRUE / FALSE )
6256 UFWORD(FILES_CREATE) {
6257   const char *fname = ufoPopFileName();
6258   //FIXME: add variable with default flags
6259   const int fd = open(fname, O_RDWR|O_CREAT|O_TRUNC, 0644);
6260   if (fd >= 0) {
6261     ufoPush((uint32_t)fd);
6262     ufoPushBool(1);
6263   } else {
6264     ufoPushBool(0);
6265   }
6266 }
6267
6268 // FILES:CLOSE
6269 // ( handle -- success? )
6270 UFWORD(FILES_CLOSE) {
6271   const int32_t fd = (int32_t)ufoPop();
6272   if (fd < 0) ufoFatal("invalid file handle in 'CLOSE'");
6273   ufoPushBool(close(fd) == 0);
6274 }
6275
6276 // FILES:TELL
6277 // ( handle -- ofs TRUE / FALSE )
6278 // `handle` cannot be 0.
6279 UFWORD(FILES_TELL) {
6280   const int32_t fd = (int32_t)ufoPop();
6281   if (fd < 0) ufoFatal("invalid file handle in 'TELL'");
6282   const off_t pos = lseek(fd, 0, SEEK_CUR);
6283   if (pos != (off_t)-1) {
6284     ufoPush((uint32_t)pos);
6285     ufoPushBool(1);
6286   } else {
6287     ufoPushBool(0);
6288   }
6289 }
6290
6291 // FILES:SEEK-EX
6292 // ( ofs whence handle -- TRUE / FALSE )
6293 // `handle` cannot be 0.
6294 UFWORD(FILES_SEEK_EX) {
6295   const int32_t fd = (int32_t)ufoPop();
6296   const uint32_t whence = ufoPop();
6297   const uint32_t ofs = ufoPop();
6298   if (fd < 0) ufoFatal("invalid file handle in 'SEEK-EX'");
6299   if (whence != (uint32_t)SEEK_SET &&
6300       whence != (uint32_t)SEEK_CUR &&
6301       whence != (uint32_t)SEEK_END) ufoFatal("invalid `whence` in 'SEEK-EX'");
6302   const off_t pos = lseek(fd, (off_t)ofs, (int)whence);
6303   ufoPushBool(pos != (off_t)-1);
6304 }
6305
6306 // FILES:SIZE
6307 // ( handle -- size TRUE / FALSE )
6308 // `handle` cannot be 0.
6309 UFWORD(FILES_SIZE) {
6310   const int32_t fd = (int32_t)ufoPop();
6311   if (fd < 0) ufoFatal("invalid file handle in 'SIZE'");
6312   const off_t origpos = lseek(fd, 0, SEEK_CUR);
6313   if (origpos == (off_t)-1) {
6314     ufoPushBool(0);
6315   } else {
6316     const off_t size = lseek(fd, 0, SEEK_END);
6317     if (size == (off_t)-1) {
6318       (void)lseek(origpos, 0, SEEK_SET);
6319       ufoPushBool(0);
6320     } else if (lseek(origpos, 0, SEEK_SET) == origpos) {
6321       ufoPush((uint32_t)size);
6322       ufoPushBool(1);
6323     } else {
6324       ufoPushBool(0);
6325     }
6326   }
6327 }
6328
6329 // FILES:READ
6330 // ( addr count handle -- rdsize TRUE / FALSE )
6331 // `handle` cannot be 0.
6332 UFWORD(FILES_READ) {
6333   const int32_t fd = (int32_t)ufoPop();
6334   if (fd < 0) ufoFatal("invalid file handle in 'READ'");
6335   uint32_t count = ufoPop();
6336   uint32_t addr = ufoPop();
6337   uint32_t done = 0;
6338   if (count != 0) {
6339     if ((count & 0x80000000U) != 0) ufoFatal("invalid number of bytes to read from file");
6340     while (count != done) {
6341       uint32_t rd = (uint32_t)sizeof(ufoFileIOBuffer);
6342       if (rd > count) rd = count;
6343       for (;;) {
6344         const ssize_t xres = read(fd, ufoFileIOBuffer, rd);
6345         if (xres >= 0) { rd = (uint32_t)xres; break; }
6346         if (errno == EINTR) continue;
6347         if (errno == EAGAIN || errno == EWOULDBLOCK) { rd = 0; break; }
6348         // error
6349         ufoPushBool(0);
6350         return;
6351       }
6352       if (rd == 0) break;
6353       done += rd;
6354       for (uint32_t f = 0; f != rd; f += 1u) {
6355         ufoImgPutU8Ext(addr, ufoFileIOBuffer[f]);
6356         addr += 1u;
6357       }
6358     }
6359   }
6360   ufoPush(done);
6361   ufoPushBool(1);
6362 }
6363
6364 // FILES:READ-EXACT
6365 // ( addr count handle -- TRUE / FALSE )
6366 // `handle` cannot be 0.
6367 UFWORD(FILES_READ_EXACT) {
6368   const int32_t fd = (int32_t)ufoPop();
6369   if (fd < 0) ufoFatal("invalid file handle in 'READ-EXACT'");
6370   uint32_t count = ufoPop();
6371   uint32_t addr = ufoPop();
6372   if (count != 0) {
6373     if ((count & 0x80000000U) != 0) ufoFatal("invalid number of bytes to read from file");
6374     while (count != 0) {
6375       uint32_t rd = (uint32_t)sizeof(ufoFileIOBuffer);
6376       if (rd > count) rd = count;
6377       for (;;) {
6378         const ssize_t xres = read(fd, ufoFileIOBuffer, rd);
6379         if (xres >= 0) { rd = (uint32_t)xres; break; }
6380         if (errno == EINTR) continue;
6381         if (errno == EAGAIN || errno == EWOULDBLOCK) { rd = 0; break; }
6382         // error
6383         ufoPushBool(0);
6384         return;
6385       }
6386       if (rd == 0) { ufoPushBool(0); return; } // still error
6387       count -= rd;
6388       for (uint32_t f = 0; f != rd; f += 1u) {
6389         ufoImgPutU8Ext(addr, ufoFileIOBuffer[f]);
6390         addr += 1u;
6391       }
6392     }
6393   }
6394   ufoPushBool(1);
6395 }
6396
6397 // FILES:WRITE
6398 // ( addr count handle -- TRUE / FALSE )
6399 // `handle` cannot be 0.
6400 UFWORD(FILES_WRITE) {
6401   const int32_t fd = (int32_t)ufoPop();
6402   if (fd < 0) ufoFatal("invalid file handle in 'WRITE'");
6403   uint32_t count = ufoPop();
6404   uint32_t addr = ufoPop();
6405   if (count != 0) {
6406     if ((count & 0x80000000U) != 0) ufoFatal("invalid number of bytes to write to file");
6407     while (count != 0) {
6408       uint32_t wr = (uint32_t)sizeof(ufoFileIOBuffer);
6409       if (wr > count) wr = count;
6410       for (uint32_t f = 0; f != wr; f += 1u) {
6411         ufoFileIOBuffer[f] = ufoImgGetU8Ext(addr + f);
6412       }
6413       for (;;) {
6414         const ssize_t xres = write(fd, ufoFileIOBuffer, wr);
6415         if (xres >= 0) { wr = (uint32_t)xres; break; }
6416         if (errno == EINTR) continue;
6417         fprintf(stderr, "ERRNO: %d (fd=%d)\n", errno, fd);
6418         //if (errno == EAGAIN || errno == EWOULDBLOCK) { wr = 0; break; }
6419         // error
6420         ufoPushBool(0);
6421         return;
6422       }
6423       if (wr == 0) { ufoPushBool(1); return; } // still error
6424       count -= wr; addr += wr;
6425     }
6426   }
6427   ufoPushBool(1);
6428 }
6429
6430
6431 // ////////////////////////////////////////////////////////////////////////// //
6432 // states
6433 //
6434
6435 //==========================================================================
6436 //
6437 //  ufoNewState
6438 //
6439 //  create a new state, its execution will start from the given CFA.
6440 //  state is not automatically activated.
6441 //
6442 //==========================================================================
6443 static UfoState *ufoNewState (void) {
6444   // find free state id
6445   uint32_t fidx = 0;
6446   uint32_t bmp = ufoStateUsedBitmap[0];
6447   while (fidx != (uint32_t)(UFO_MAX_STATES/32) && bmp == ~(uint32_t)0) {
6448     fidx += 1u;
6449     bmp = ufoStateUsedBitmap[fidx];
6450   }
6451   if (fidx == (uint32_t)(UFO_MAX_STATES/32)) ufoFatal("too many execution states");
6452   //fprintf(stderr, "NST:000: fidx=%u; bmp=0x%08x\n", fidx, bmp);
6453   fidx *= 32u;
6454   while ((bmp & 0x01) != 0) { fidx += 1u; bmp >>= 1; }
6455   ufo_assert(fidx < UFO_MAX_STATES);
6456   ufo_assert((ufoStateUsedBitmap[fidx / 32u] & ((uint32_t)1 << (fidx & 0x1f))) == 0);
6457   ufo_assert(ufoStateMap[fidx] == NULL);
6458   UfoState *st = calloc(1, sizeof(UfoState));
6459   if (st == NULL) ufoFatal("out of memory for states");
6460   st->id = fidx + 1u;
6461   ufoStateMap[fidx] = st;
6462   ufoStateUsedBitmap[fidx / 32u] |= ((uint32_t)1 << (fidx & 0x1f));
6463   //fprintf(stderr, "NST: fidx=%u; 0x%08x\n", fidx, ufoStateUsedBitmap[fidx / 32u]);
6464   return st;
6465 }
6466
6467
6468 //==========================================================================
6469 //
6470 //  ufoFreeState
6471 //
6472 //  free all memory used for the state, remove it from state list.
6473 //  WARNING! never free current state!
6474 //
6475 //==========================================================================
6476 static void ufoFreeState (UfoState *st) {
6477   if (st != NULL) {
6478     if (st == ufoCurrState) ufoFatal("cannot free active state");
6479     if (ufoYieldedState == st) ufoYieldedState = NULL;
6480     if (ufoDebuggerState == st) ufoDebuggerState = NULL;
6481     const uint32_t fidx = st->id - 1u;
6482     //fprintf(stderr, "FST: fidx=%u; 0x%08x\n", fidx, ufoStateUsedBitmap[fidx / 32u]);
6483     ufo_assert(fidx < UFO_MAX_STATES);
6484     ufo_assert((ufoStateUsedBitmap[fidx / 32u] & (1u << (fidx & 0x1f))) != 0);
6485     ufo_assert(ufoStateMap[fidx] == st);
6486     // free default TIB handle
6487     UfoState *oldst = ufoCurrState;
6488     ufoCurrState = st;
6489     const uint32_t tib = ufoImgGetU32(ufoAddrDefTIB);
6490     if ((tib & UFO_ADDR_TEMP_BIT) != 0) {
6491       UfoHandle *tibh = ufoGetHandle(tib);
6492       if (tibh != NULL) ufoFreeHandle(tibh);
6493     }
6494     ufoCurrState = oldst;
6495     // free temp buffer
6496     if (st->imageTemp != NULL) free(st->imageTemp);
6497     free(st);
6498     ufoStateMap[fidx] = NULL;
6499     ufoStateUsedBitmap[fidx / 32u] &= ~((uint32_t)1 << (fidx & 0x1f));
6500   }
6501 }
6502
6503
6504 //==========================================================================
6505 //
6506 //  ufoFindState
6507 //
6508 //==========================================================================
6509 static UfoState *ufoFindState (uint32_t stid) {
6510   UfoState *res = NULL;
6511   if (stid >= 0 && stid <= UFO_MAX_STATES) {
6512     if (stid == 0) {
6513       // current
6514       ufo_assert(ufoCurrState != NULL);
6515       stid = ufoCurrState->id - 1u;
6516     } else {
6517       stid -= 1u;
6518     }
6519     res = ufoStateMap[stid];
6520     if (res != NULL) {
6521       ufo_assert((ufoStateUsedBitmap[stid / 32u] & (1u << (stid & 0x1f))) != 0);
6522       ufo_assert(res->id == stid + 1u);
6523     } else {
6524       ufo_assert((ufoStateUsedBitmap[stid / 32u] & (1u << (stid & 0x1f))) == 0);
6525     }
6526   }
6527   return res;
6528 }
6529
6530
6531 //==========================================================================
6532 //
6533 //  ufoSwitchToState
6534 //
6535 //==========================================================================
6536 static void ufoSwitchToState (UfoState *newst) {
6537   ufo_assert(newst != NULL);
6538   if (newst != ufoCurrState) {
6539     ufoCurrState = newst;
6540   }
6541 }
6542
6543
6544 // ////////////////////////////////////////////////////////////////////////// //
6545 // initial dictionary definitions
6546 //
6547
6548 #undef UFWORD
6549
6550 #define UFWORD(name_)  do { \
6551   const uint32_t xcfa_ = ufoCFAsUsed; \
6552   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
6553   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
6554   ufoCFAsUsed += 1; \
6555   ufoDefineNative(""#name_, xcfa_, 0); \
6556 } while (0)
6557
6558 #define UFWORDX(strname_,name_)  do { \
6559   const uint32_t xcfa_ = ufoCFAsUsed; \
6560   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
6561   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
6562   ufoCFAsUsed += 1; \
6563   ufoDefineNative(strname_, xcfa_, 0); \
6564 } while (0)
6565
6566 #define UFWORD_IMM(name_)  do { \
6567   const uint32_t xcfa_ = ufoCFAsUsed; \
6568   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
6569   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
6570   ufoCFAsUsed += 1; \
6571   ufoDefineNative(""#name_, xcfa_, 1); \
6572 } while (0)
6573
6574 #define UFWORDX_IMM(strname_,name_)  do { \
6575   const uint32_t xcfa_ = ufoCFAsUsed; \
6576   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
6577   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
6578   ufoCFAsUsed += 1; \
6579   ufoDefineNative(strname_, xcfa_, 1); \
6580 } while (0)
6581
6582 #define UFC(name_)  ufoImgEmitU32_NoInline(ufoFindWordChecked(name_))
6583
6584
6585 //==========================================================================
6586 //
6587 //  ufoFindWordChecked
6588 //
6589 //==========================================================================
6590 UFO_DISABLE_INLINE uint32_t ufoFindWordChecked (const char *wname) {
6591   const uint32_t cfa = ufoFindWord(wname);
6592   if (cfa == 0) ufoFatal("word '%s' not found", wname);
6593   return cfa;
6594 }
6595
6596
6597 //==========================================================================
6598 //
6599 //  ufoGetForthVocId
6600 //
6601 //  get "FORTH" vocid
6602 //
6603 //==========================================================================
6604 uint32_t ufoGetForthVocId (void) {
6605   return ufoForthVocId;
6606 }
6607
6608
6609 //==========================================================================
6610 //
6611 //  ufoVocSetOnlyDefs
6612 //
6613 //==========================================================================
6614 void ufoVocSetOnlyDefs (uint32_t vocid) {
6615   ufoImgPutU32(ufoAddrCurrent, vocid);
6616   ufoImgPutU32(ufoAddrContext, vocid);
6617 }
6618
6619
6620 //==========================================================================
6621 //
6622 //  ufoCreateVoc
6623 //
6624 //  return voc PFA (vocid)
6625 //
6626 //==========================================================================
6627 uint32_t ufoCreateVoc (const char *wname, uint32_t parentvocid, uint32_t flags) {
6628   // create wordlist struct
6629   // typeid, used by Forth code (structs and such)
6630   ufoImgEmitU32(0); // typeid
6631   // vocid points here, to "LATEST-LFA"
6632   const uint32_t vocid = UFO_GET_DP();
6633   //fprintf(stderr, "NEW VOCID (%s): 0x%08x\n", wname, vocid);
6634   ufoImgEmitU32(0); // latest
6635   const uint32_t vlink = UFO_GET_DP();
6636   if ((vocid & UFO_ADDR_TEMP_BIT) == 0) {
6637     ufoImgEmitU32(ufoImgGetU32(ufoAddrVocLink)); // voclink
6638     ufoImgPutU32(ufoAddrVocLink, vlink); // update voclink
6639   } else {
6640     abort();
6641     ufoImgEmitU32(0);
6642   }
6643   ufoImgEmitU32(parentvocid); // parent
6644   const uint32_t hdraddr = UFO_GET_DP();
6645   ufoImgEmitU32(0); // word header
6646   // create empty hash table
6647   for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) ufoImgEmitU32(0);
6648   // update CONTEXT and CURRENT if this is the first wordlist ever
6649   if (ufoImgGetU32(ufoAddrContext) == 0) {
6650     ufoImgPutU32(ufoAddrContext, vocid);
6651   }
6652   if (ufoImgGetU32(ufoAddrCurrent) == 0) {
6653     ufoImgPutU32(ufoAddrCurrent, vocid);
6654   }
6655   // create word header
6656   if (wname != NULL && wname[0] != 0) {
6657     /*
6658     uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6659     flags &=
6660       //UFW_FLAG_IMMEDIATE|
6661       //UFW_FLAG_SMUDGE|
6662       //UFW_FLAG_NORETURN|
6663       UFW_FLAG_HIDDEN|
6664       //UFW_FLAG_CBLOCK|
6665       //UFW_FLAG_VOCAB|
6666       //UFW_FLAG_SCOLON|
6667       UFW_FLAG_PROTECTED;
6668     flags |= UFW_FLAG_VOCAB;
6669     */
6670     flags &= 0xffffff00u;
6671     flags |= UFW_FLAG_VOCAB;
6672     ufoCreateWordHeader(wname, flags);
6673     const uint32_t cfa = UFO_GET_DP();
6674     ufoImgEmitU32(ufoDoVocCFA); // cfa
6675     ufoImgEmitU32(vocid); // pfa
6676     // update vocab header pointer
6677     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
6678     ufoImgPutU32(hdraddr, UFO_LFA_TO_NFA(lfa));
6679     #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
6680     ufoDumpWordHeader(lfa);
6681     #endif
6682   }
6683   return vocid;
6684 }
6685
6686
6687 //==========================================================================
6688 //
6689 //  ufoSetLatestArgs
6690 //
6691 //==========================================================================
6692 static void ufoSetLatestArgs (uint32_t warg) {
6693   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
6694   const uint32_t lfa = ufoImgGetU32(curr);
6695   const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
6696   uint32_t flags = ufoImgGetU32(nfa);
6697   //fprintf(stderr, "OLD FLAGS: 0x%08x\n", flags);
6698   flags &= ~UFW_WARG_MASK;
6699   flags |= warg & UFW_WARG_MASK;
6700   //fprintf(stderr, "NEW FLAGS: 0x%08x\n", flags);
6701   ufoImgPutU32(nfa, flags);
6702   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
6703   ufoDumpWordHeader(lfa);
6704   #endif
6705 }
6706
6707
6708 //==========================================================================
6709 //
6710 //  ufoDefine
6711 //
6712 //==========================================================================
6713 static void ufoDefineNative (const char *wname, uint32_t cfaidx, int immed) {
6714   cfaidx |= UFO_ADDR_CFA_BIT;
6715   uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6716   flags &=
6717       //UFW_FLAG_IMMEDIATE|
6718       //UFW_FLAG_SMUDGE|
6719       //UFW_FLAG_NORETURN|
6720       UFW_FLAG_HIDDEN|
6721       //UFW_FLAG_CBLOCK|
6722       //UFW_FLAG_VOCAB|
6723       //UFW_FLAG_SCOLON|
6724       UFW_FLAG_PROTECTED;
6725   if (immed) flags |= UFW_FLAG_IMMEDIATE;
6726   ufoCreateWordHeader(wname, flags);
6727   ufoImgEmitU32(cfaidx);
6728 }
6729
6730
6731 //==========================================================================
6732 //
6733 //  ufoDefineConstant
6734 //
6735 //==========================================================================
6736 static void ufoDefineConstant (const char *name, uint32_t value) {
6737   ufoDefineNative(name, ufoDoConstCFA, 0);
6738   ufoImgEmitU32(value);
6739 }
6740
6741
6742 //==========================================================================
6743 //
6744 //  ufoDefineUserVar
6745 //
6746 //==========================================================================
6747 static void ufoDefineUserVar (const char *name, uint32_t addr) {
6748   ufoDefineNative(name, ufoDoUserVariableCFA, 0);
6749   ufoImgEmitU32(addr);
6750 }
6751
6752
6753 //==========================================================================
6754 //
6755 //  ufoDefineVar
6756 //
6757 //==========================================================================
6758 /*
6759 static void ufoDefineVar (const char *name, uint32_t value) {
6760   ufoDefineNative(name, ufoDoVarCFA, 0);
6761   ufoImgEmitU32(value);
6762 }
6763 */
6764
6765
6766 //==========================================================================
6767 //
6768 //  ufoDefineDefer
6769 //
6770 //==========================================================================
6771 /*
6772 static void ufoDefineDefer (const char *name, uint32_t value) {
6773   ufoDefineNative(name, ufoDoDeferCFA, 0);
6774   ufoImgEmitU32(value);
6775 }
6776 */
6777
6778
6779 //==========================================================================
6780 //
6781 //  ufoHiddenWords
6782 //
6783 //==========================================================================
6784 static void ufoHiddenWords (void) {
6785   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6786   ufoImgPutU32(ufoAddrNewWordFlags, flags | UFW_FLAG_HIDDEN);
6787 }
6788
6789
6790 //==========================================================================
6791 //
6792 //  ufoPublicWords
6793 //
6794 //==========================================================================
6795 static void ufoPublicWords (void) {
6796   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6797   ufoImgPutU32(ufoAddrNewWordFlags, flags & ~UFW_FLAG_HIDDEN);
6798 }
6799
6800
6801 //==========================================================================
6802 //
6803 //  ufoDefineForth
6804 //
6805 //==========================================================================
6806 /*
6807 static void ufoDefineForth (const char *name) {
6808   ufoDefineNative(name, ufoDoForthCFA, 0);
6809 }
6810 */
6811
6812
6813 //==========================================================================
6814 //
6815 //  ufoDefineForthImm
6816 //
6817 //==========================================================================
6818 /*
6819 static void ufoDefineForthImm (const char *name) {
6820   ufoDefineNative(name, ufoDoForthCFA, 1);
6821 }
6822 */
6823
6824
6825 //==========================================================================
6826 //
6827 //  ufoDefineForthHidden
6828 //
6829 //==========================================================================
6830 /*
6831 static void ufoDefineForthHidden (const char *name) {
6832   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
6833   ufoImgPutU32(ufoAddrNewWordFlags, flags | UFW_FLAG_HIDDEN);
6834   ufoDefineNative(name, ufoDoForthCFA, 0);
6835   ufoImgPutU32(ufoAddrNewWordFlags, flags);
6836 }
6837 */
6838
6839
6840 //==========================================================================
6841 //
6842 //  ufoDefineSColonForth
6843 //
6844 //  create word suitable for scattered colon extension
6845 //
6846 //==========================================================================
6847 static void ufoDefineSColonForth (const char *name) {
6848   ufoDefineNative(name, ufoDoForthCFA, 0);
6849   // placeholder for scattered colon
6850   // it will compile two branches:
6851   // the first branch will jump to the first "..:" word (or over the two branches)
6852   // the second branch is never taken, and works as a pointer to the latest branch addr in the list
6853   // this way, each extension word will simply fix the last branch address, and update list tail
6854   // at the creation time, second branch points to the first branch
6855   UFC("FORTH:(BRANCH)");
6856   const uint32_t xjmp = UFO_GET_DP();
6857   ufoImgEmitU32(0);
6858   UFC("FORTH:(BRANCH)"); ufoImgEmitU32(xjmp);
6859   ufoImgPutU32(xjmp, UFO_GET_DP());
6860 }
6861
6862
6863 //==========================================================================
6864 //
6865 //  ufoDoneForth
6866 //
6867 //==========================================================================
6868 UFO_FORCE_INLINE void ufoDoneForth (void) {
6869   UFC("FORTH:(EXIT)");
6870 }
6871
6872
6873 //==========================================================================
6874 //
6875 //  ufoCompileStrLit
6876 //
6877 //  compile string literal, the same as QUOTE_IMM
6878 //
6879 //==========================================================================
6880 static void ufoCompileStrLitEx (const char *str, const uint32_t slen) {
6881   if (str == NULL) str = "";
6882   if (slen > 255) ufoFatal("string literal too long");
6883   UFC("FORTH:(LITSTR8)");
6884   ufoImgEmitU8((uint8_t)slen);
6885   for (size_t f = 0; f < slen; f += 1) {
6886     ufoImgEmitU8(((const unsigned char *)str)[f]);
6887   }
6888   ufoImgEmitU8(0);
6889   ufoImgEmitAlign();
6890 }
6891
6892
6893 //==========================================================================
6894 //
6895 //  ufoCompileStrLit
6896 //
6897 //==========================================================================
6898 /*
6899 static void ufoCompileStrLit (const char *str) {
6900   ufoCompileStrLitEx(str, (uint32_t)strlen(str));
6901 }
6902 */
6903
6904
6905 //==========================================================================
6906 //
6907 //  ufoCompileLit
6908 //
6909 //==========================================================================
6910 static void ufoCompileLit (uint32_t value) {
6911   UFC("FORTH:(LIT)");
6912   ufoImgEmitU32(value);
6913 }
6914
6915
6916 //==========================================================================
6917 //
6918 //  ufoCompileCFALit
6919 //
6920 //==========================================================================
6921 /*
6922 static void ufoCompileCFALit (const char *wname) {
6923   UFC("FORTH:(LITCFA)");
6924   const uint32_t cfa = ufoFindWordChecked(wname);
6925   ufoImgEmitU32(cfa);
6926 }
6927 */
6928
6929
6930 //==========================================================================
6931 //
6932 //  ufoXStrEquCI
6933 //
6934 //==========================================================================
6935 static int ufoXStrEquCI (const char *word, const char *text, uint32_t tlen) {
6936   while (tlen != 0 && *word) {
6937     if (toUpper(*word) != toUpper(*text)) return 0;
6938     word += 1u; text += 1u; tlen -= 1u;
6939   }
6940   return (tlen == 0 && *word == 0);
6941 }
6942
6943
6944 #define UFO_MAX_LABEL_NAME  (63)
6945 typedef struct UfoLabel_t {
6946   uint32_t hash;
6947   uint32_t namelen;
6948   char name[UFO_MAX_LABEL_NAME];
6949   uint32_t addr; // jump chain tail, or address
6950   uint32_t defined;
6951   uint32_t word; // is this a forward word definition?
6952   struct UfoLabel_t *next;
6953 } UfoLabel;
6954
6955 static UfoLabel *ufoLabels = NULL;
6956
6957
6958 //==========================================================================
6959 //
6960 //  ufoFindAddLabelEx
6961 //
6962 //==========================================================================
6963 static UfoLabel *ufoFindAddLabelEx (const char *name, uint32_t namelen, int allowAdd) {
6964   if (namelen == 0 || namelen > UFO_MAX_LABEL_NAME) ufoFatal("invalid label name");
6965   const uint32_t hash = joaatHashBufCI(name, namelen);
6966   UfoLabel *lbl = ufoLabels;
6967   while (lbl != NULL) {
6968     if (lbl->hash == hash && lbl->namelen == namelen) {
6969       int ok = 1;
6970       uint32_t sidx = 0;
6971       while (ok && sidx != namelen) {
6972         ok = (toUpper(name[sidx]) == toUpper(lbl->name[sidx]));
6973         sidx += 1;
6974       }
6975       if (ok) return lbl;
6976     }
6977     lbl = lbl->next;
6978   }
6979   if (allowAdd) {
6980     // create new label
6981     lbl = calloc(1, sizeof(UfoLabel));
6982     lbl->hash = hash;
6983     lbl->namelen = namelen;
6984     memcpy(lbl->name, name, namelen);
6985     lbl->name[namelen] = 0;
6986     lbl->next = ufoLabels;
6987     ufoLabels = lbl;
6988     return lbl;
6989   } else {
6990     return NULL;
6991   }
6992 }
6993
6994
6995 //==========================================================================
6996 //
6997 //  ufoFindAddLabel
6998 //
6999 //==========================================================================
7000 static UfoLabel *ufoFindAddLabel (const char *name, uint32_t namelen) {
7001   return ufoFindAddLabelEx(name, namelen, 1);
7002 }
7003
7004
7005 //==========================================================================
7006 //
7007 //  ufoFindLabel
7008 //
7009 //==========================================================================
7010 static UfoLabel *ufoFindLabel (const char *name, uint32_t namelen) {
7011   return ufoFindAddLabelEx(name, namelen, 0);
7012 }
7013
7014
7015 //==========================================================================
7016 //
7017 //  ufoTrySimpleNumber
7018 //
7019 //  only decimal and C-like hexes; with an optional sign
7020 //
7021 //==========================================================================
7022 static int ufoTrySimpleNumber (const char *text, uint32_t tlen, uint32_t *num) {
7023   int neg = 0;
7024
7025   if (tlen != 0 && *text == '+') { text += 1u; tlen -= 1u; }
7026   else if (tlen != 0 && *text == '-') { neg = 1; text += 1u; tlen -= 1u; }
7027
7028   int base = 10; // default base
7029   if (tlen > 2 && text[0] == '0' && toUpper(text[1]) == 'X') {
7030     // hex
7031     base = 16;
7032     text += 2u; tlen -= 2u;
7033   }
7034
7035   if (tlen == 0 || digitInBase(*text, base) < 0) return 0;
7036
7037   int wasDigit = 0;
7038   uint32_t n = 0;
7039   int dig;
7040   while (tlen != 0) {
7041     if (*text == '_') {
7042       if (!wasDigit) return 0;
7043       wasDigit = 0;
7044     } else {
7045       dig = digitInBase(*text, base);
7046       if (dig < 0) return 0;
7047       wasDigit = 1;
7048       n = n * (uint32_t)base + (uint32_t)dig;
7049     }
7050     text += 1u; tlen -= 1u;
7051   }
7052
7053   if (!wasDigit) return 0;
7054   if (neg) n = ~n + 1u;
7055   *num = n;
7056   return 1;
7057 }
7058
7059
7060 //==========================================================================
7061 //
7062 //  ufoEmitLabelChain
7063 //
7064 //==========================================================================
7065 static void ufoEmitLabelChain (UfoLabel *lbl) {
7066   ufo_assert(lbl != NULL);
7067   ufo_assert(lbl->defined == 0);
7068   const uint32_t here = UFO_GET_DP();
7069   ufoImgEmitU32(lbl->addr);
7070   lbl->addr = here;
7071 }
7072
7073
7074 //==========================================================================
7075 //
7076 //  ufoFixLabelChainHere
7077 //
7078 //==========================================================================
7079 static void ufoFixLabelChainHere (UfoLabel *lbl) {
7080   ufo_assert(lbl != NULL);
7081   ufo_assert(lbl->defined == 0);
7082   const uint32_t here = UFO_GET_DP();
7083   while (lbl->addr != 0) {
7084     const uint32_t aprev = ufoImgGetU32(lbl->addr);
7085     ufoImgPutU32(lbl->addr, here);
7086     lbl->addr = aprev;
7087   }
7088   lbl->addr = here;
7089   lbl->defined = 1;
7090 }
7091
7092
7093 #define UFO_MII_WORD_COMPILE_IMM (-4)
7094 #define UFO_MII_WORD_CFA_LIT     (-3)
7095 #define UFO_MII_WORD_COMPILE     (-2)
7096 #define UFO_MII_IN_WORD          (-1)
7097 #define UFO_MII_NO_WORD          (0)
7098 #define UFO_MII_WORD_NAME        (1)
7099 #define UFO_MII_WORD_NAME_IMM    (2)
7100 #define UFO_MII_WORD_NAME_HIDDEN (3)
7101
7102 static int ufoMinInterpState = UFO_MII_NO_WORD;
7103
7104
7105 //==========================================================================
7106 //
7107 //  ufoFinalLabelCheck
7108 //
7109 //==========================================================================
7110 static void ufoFinalLabelCheck (void) {
7111   int errorCount = 0;
7112   if (ufoMinInterpState != UFO_MII_NO_WORD) {
7113     ufoFatal("missing semicolon");
7114   }
7115   while (ufoLabels != NULL) {
7116     UfoLabel *lbl = ufoLabels; ufoLabels = lbl->next;
7117     if (!lbl->defined) {
7118       fprintf(stderr, "UFO ERROR: label '%s' is not defined!\n", lbl->name);
7119       errorCount += 1;
7120     }
7121     free(lbl);
7122   }
7123   if (errorCount != 0) {
7124     ufoFatal("%d undefined label%s", errorCount, (errorCount != 1 ? "s" : ""));
7125   }
7126 }
7127
7128
7129 //==========================================================================
7130 //
7131 //  ufoInterpretLine
7132 //
7133 //  this is so i could write Forth definitions more easily
7134 //
7135 //  labels:
7136 //    $name -- reference
7137 //    $name: -- definition
7138 //
7139 //==========================================================================
7140 UFO_DISABLE_INLINE void ufoInterpretLine (const char *line) {
7141   char wname[UFO_MAX_WORD_LENGTH];
7142   uint32_t wlen, num, cfa;
7143   UfoLabel *lbl;
7144   while (*line) {
7145     if (*(const unsigned char *)line <= 32) {
7146       line += 1;
7147     } else if (ufoMinInterpState == UFO_MII_WORD_CFA_LIT ||
7148                ufoMinInterpState == UFO_MII_WORD_COMPILE ||
7149                ufoMinInterpState == UFO_MII_WORD_COMPILE_IMM)
7150     {
7151       // "[']"/"COMPILE"/"[COMPILE]" argument
7152       wlen = 1;
7153       while (((const unsigned char *)line)[wlen] > 32) wlen += 1;
7154       if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
7155       memcpy(wname, line, wlen);
7156       wname[wlen] = 0;
7157       switch (ufoMinInterpState) {
7158         case UFO_MII_WORD_CFA_LIT: UFC("FORTH:(LITCFA)"); break;
7159         case UFO_MII_WORD_COMPILE: UFC("FORTH:(LITCFA)"); break;
7160         case UFO_MII_WORD_COMPILE_IMM: break;
7161         default: ufo_assert(0);
7162       }
7163       cfa = ufoFindWord(wname);
7164       if (cfa != 0) {
7165         ufoImgEmitU32(cfa);
7166       } else {
7167         // forward reference
7168         lbl = ufoFindAddLabel(line, wlen);
7169         if (lbl->defined || (lbl->word == 0 && lbl->addr)) {
7170           ufoFatal("unknown word: '%s'", wname);
7171         }
7172         lbl->word = 1;
7173         ufoEmitLabelChain(lbl);
7174       }
7175       switch (ufoMinInterpState) {
7176         case UFO_MII_WORD_CFA_LIT: break;
7177         case UFO_MII_WORD_COMPILE: UFC("FORTH:COMPILE,"); break;
7178         case UFO_MII_WORD_COMPILE_IMM: break;
7179         default: ufo_assert(0);
7180       }
7181       ufoMinInterpState = UFO_MII_IN_WORD;
7182       line += wlen;
7183     } else if (ufoMinInterpState > UFO_MII_NO_WORD) {
7184       // new word
7185       wlen = 1;
7186       while (((const unsigned char *)line)[wlen] > 32) wlen += 1;
7187       if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
7188       if (wlen > 2 && line[0] == ':' && line[wlen - 1u] == ':') ufoFatal("invalid word name");
7189       memcpy(wname, line, wlen);
7190       wname[wlen] = 0;
7191       const uint32_t oldFlags = ufoImgGetU32(ufoAddrNewWordFlags);
7192       if (ufoMinInterpState == UFO_MII_WORD_NAME_HIDDEN) {
7193         ufoImgPutU32(ufoAddrNewWordFlags, oldFlags | UFW_FLAG_HIDDEN);
7194       }
7195       ufoDefineNative(wname, ufoDoForthCFA, (ufoMinInterpState == UFO_MII_WORD_NAME_IMM));
7196       ufoImgPutU32(ufoAddrNewWordFlags, oldFlags);
7197       ufoMinInterpState = UFO_MII_IN_WORD;
7198       // check for forward references
7199       lbl = ufoFindLabel(line, wlen);
7200       if (lbl != NULL) {
7201         if (lbl->defined || !lbl->word) {
7202           ufoFatal("label/word conflict for '%.*s'", (unsigned)wlen, line);
7203         }
7204         ufoFixLabelChainHere(lbl);
7205       }
7206       line += wlen;
7207     } else if ((line[0] == ';' && line[1] == ';') ||
7208                (line[0] == '-' && line[1] == '-') ||
7209                (line[0] == '/' && line[1] == '/') ||
7210                (line[0] == '\\' && ((const unsigned char *)line)[1] <= 32))
7211     {
7212       ufoFatal("do not use single-line comments");
7213     } else if (line[0] == '(' && ((const unsigned char *)line)[1] <= 32) {
7214       while (*line && *line != ')') line += 1;
7215       if (*line == ')') line += 1;
7216     } else {
7217       // word
7218       wlen = 1;
7219       while (((const unsigned char *)line)[wlen] > 32) wlen += 1;
7220       if (wlen == 1 && (line[0] == '"' || line[0] == '`')) {
7221         // string literal
7222         const char qch = line[0];
7223         if (!line[1]) ufoFatal("unterminated string literal");
7224         // skip quote and space
7225         if (((const unsigned char *)line)[1] <= 32) line += 2u; else line += 1u;
7226         wlen = 0;
7227         while (line[wlen] && line[wlen] != qch) wlen += 1u;
7228         if (line[wlen] != qch) ufoFatal("unterminated string literal");
7229         ufoCompileStrLitEx(line, wlen);
7230         line += wlen + 1u; // skip final quote
7231       } else if (wlen == 1 && line[0] == ':') {
7232         // new word
7233         if (ufoMinInterpState != UFO_MII_NO_WORD) ufoFatal("unexpected colon");
7234         ufoMinInterpState = UFO_MII_WORD_NAME;
7235         line += wlen;
7236       } else if (wlen == 1 && line[0] == ';') {
7237         // end word
7238         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected semicolon");
7239         ufoImgEmitU32(ufoFindWordChecked("FORTH:(EXIT)"));
7240         ufoMinInterpState = UFO_MII_NO_WORD;
7241         line += wlen;
7242       } else if (wlen == 2 && line[0] == '!' && line[1] == ':') {
7243         // new immediate word
7244         if (ufoMinInterpState != UFO_MII_NO_WORD) ufoFatal("unexpected colon");
7245         ufoMinInterpState = UFO_MII_WORD_NAME_IMM;
7246         line += wlen;
7247       } else if (wlen == 2 && line[0] == '*' && line[1] == ':') {
7248         // new hidden word
7249         if (ufoMinInterpState != UFO_MII_NO_WORD) ufoFatal("unexpected colon");
7250         ufoMinInterpState = UFO_MII_WORD_NAME_HIDDEN;
7251         line += wlen;
7252       } else if (wlen == 3 && memcmp(line, "[']", 3) == 0) {
7253         // cfa literal
7254         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
7255         ufoMinInterpState = UFO_MII_WORD_CFA_LIT;
7256         line += wlen;
7257       } else if (wlen == 7 && ufoXStrEquCI("COMPILE", line, wlen)) {
7258         // "COMPILE"
7259         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
7260         ufoMinInterpState = UFO_MII_WORD_COMPILE;
7261         line += wlen;
7262       } else if (wlen == 9 && ufoXStrEquCI("[COMPILE]", line, wlen)) {
7263         // "[COMPILE]"
7264         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
7265         ufoMinInterpState = UFO_MII_WORD_COMPILE_IMM;
7266         line += wlen;
7267       } else {
7268         // look for a word
7269         if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
7270         memcpy(wname, line, wlen);
7271         wname[wlen] = 0;
7272         cfa = ufoFindWord(wname);
7273         if (cfa != 0) {
7274           // compile word
7275           ufoImgEmitU32(cfa);
7276         } else if (ufoTrySimpleNumber(line, wlen, &num)) {
7277           // compile numeric literal
7278           ufoCompileLit(num);
7279         } else {
7280           // unknown word, this may be a forward reference, or a label definition
7281           // label defintion starts with "$"
7282           // (there are no words starting with "$" in the initial image)
7283           if (line[0] == '$') {
7284             if (wlen == 1) ufoFatal("dollar what?");
7285             if (wlen > 2 && line[wlen - 1u] == ':') {
7286               // label definition
7287               lbl = ufoFindAddLabel(line, wlen - 1u);
7288               if (lbl->defined) ufoFatal("double label '%s' definition", lbl->name);
7289               ufoFixLabelChainHere(lbl);
7290             } else {
7291               // label reference
7292               lbl = ufoFindAddLabel(line, wlen);
7293               if (lbl->defined) {
7294                 ufoImgEmitU32(lbl->addr);
7295               } else {
7296                 ufoEmitLabelChain(lbl);
7297               }
7298             }
7299           } else {
7300             // forward reference
7301             lbl = ufoFindAddLabel(line, wlen);
7302             if (lbl->defined || (lbl->word == 0 && lbl->addr)) {
7303               ufoFatal("unknown word: '%s'", wname);
7304             }
7305             lbl->word = 1;
7306             ufoEmitLabelChain(lbl);
7307           }
7308         }
7309         line += wlen;
7310       }
7311     }
7312   }
7313 }
7314
7315
7316 //==========================================================================
7317 //
7318 //  ufoReset
7319 //
7320 //==========================================================================
7321 UFO_DISABLE_INLINE void ufoReset (void) {
7322   if (ufoCurrState == NULL) ufoFatal("no active execution state");
7323
7324   ufoSP = 0; ufoRP = 0;
7325   ufoLP = 0; ufoLBP = 0;
7326
7327   ufoInRunWord = 0;
7328   ufoVMStop = 0; ufoVMAbort = 0;
7329
7330   ufoInBacktrace = 0;
7331
7332   // save TIB
7333   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
7334   const uint32_t tibDef = ufoImgGetU32(ufoAddrDefTIB);
7335   ufoInitStateUserVars(ufoCurrState, 0);
7336   // restore TIB
7337   ufoImgPutU32(ufoAddrTIBx, tib);
7338   ufoImgPutU32(ufoAddrDefTIB, tibDef);
7339   ufoImgPutU32(ufoAddrRedefineWarning, UFO_REDEF_WARN_NORMAL);
7340   ufoResetTib();
7341
7342   ufoImgPutU32(ufoAddrDPTemp, 0);
7343
7344   ufoImgPutU32(ufoAddrNewWordFlags, 0);
7345   ufoVocSetOnlyDefs(ufoForthVocId);
7346 }
7347
7348
7349 //==========================================================================
7350 //
7351 //  ufoDefineEmitType
7352 //
7353 //==========================================================================
7354 UFO_DISABLE_INLINE void ufoDefineEmitType (void) {
7355   // EMIT
7356   // ( ch -- )
7357   ufoInterpretLine(": EMIT  ( ch -- )  (NORM-EMIT-CHAR) (EMIT) ;");
7358
7359   // XEMIT
7360   // ( ch -- )
7361   ufoInterpretLine(": XEMIT  ( ch -- )  (NORM-XEMIT-CHAR) (EMIT) ;");
7362
7363   // CR
7364   // ( -- )
7365   ufoInterpretLine(": CR  ( -- )  NL (EMIT) ;");
7366
7367   // ENDCR
7368   // ( -- )
7369   ufoInterpretLine(
7370     ": ENDCR  ( -- ) "
7371     "  LASTCR? FORTH:(TBRANCH) $endcr-exit CR "
7372     "$endcr-exit: "
7373     ";");
7374   //ufoDecompileWord(ufoFindWordChecked("ENDCR"));
7375
7376   // SPACE
7377   // ( -- )
7378   ufoInterpretLine(": SPACE  ( -- )  BL (EMIT) ;");
7379
7380   // SPACES
7381   // ( count -- )
7382   ufoInterpretLine(
7383     ": SPACES  ( count -- ) "
7384     "$spaces-again: "
7385     "    DUP 0> FORTH:(0BRANCH) $spaces-exit "
7386     "    SPACE 1- "
7387     "    FORTH:(BRANCH) $spaces-again "
7388     "$spaces-exit: "
7389     "  DROP "
7390     ";");
7391
7392   // TYPE
7393   // ( addr count -- )
7394   ufoInterpretLine(
7395     ": TYPE  ( addr count -- ) "
7396     "  A>R SWAP >A "
7397     "$type-again: "
7398     "    DUP 0> FORTH:(0BRANCH) $type-exit "
7399     "    C@A EMIT +1>A "
7400     "    1- "
7401     "    FORTH:(BRANCH) $type-again "
7402     "$type-exit: "
7403     "  DROP R>A "
7404     ";");
7405
7406   // XTYPE
7407   // ( addr count -- )
7408   ufoInterpretLine(
7409     ": XTYPE  ( addr count -- ) "
7410     "  A>R SWAP >A "
7411     "$xtype-again: "
7412     "    DUP 0> FORTH:(0BRANCH) $xtype-exit "
7413     "    C@A XEMIT +1>A "
7414     "    1- "
7415     "    FORTH:(BRANCH) $xtype-again "
7416     "$xtype-exit: "
7417     "  DROP R>A "
7418     ";");
7419
7420   // HERE
7421   // ( -- here )
7422   ufoInterpretLine(
7423     ": HERE  ( -- here ) "
7424     "  FORTH:(DP-TEMP) @ ?DUP "
7425     "  FORTH:(TBRANCH) $here-exit "
7426     "  FORTH:(DP) @ "
7427     "$here-exit: "
7428     ";");
7429
7430   // ALIGN-HERE
7431   // ( -- )
7432   ufoInterpretLine(
7433     ": ALIGN-HERE  ( -- ) "
7434     "$align-here-loop: "
7435     "  HERE 3 AND "
7436     "  FORTH:(0BRANCH) $align-here-exit "
7437     "  0 C, "
7438     "  FORTH:(BRANCH) $align-here-loop "
7439     "$align-here-exit: "
7440     ";");
7441
7442   // STRLITERAL
7443   // ( C:addr count -- )  ( E: -- addr count )
7444   ufoInterpretLine(
7445     ": STRLITERAL  ( C:addr count -- )  ( E: -- addr count ) "
7446     "  DUP 255 U> ` string literal too long` ?ERROR "
7447     "  STATE @ FORTH:(0BRANCH) $strlit-exit "
7448     "  ( addr count ) "
7449     "  ['] FORTH:(LITSTR8) COMPILE, "
7450     "  A>R SWAP >A "
7451     "  ( compile length ) "
7452     "  DUP C, "
7453     "  ( compile chars ) "
7454     "$strlit-loop: "
7455     "    DUP 0<> FORTH:(0BRANCH) $strlit-loop-exit "
7456     "    C@A C, +1>A  1- "
7457     "  FORTH:(BRANCH) $strlit-loop "
7458     "$strlit-loop-exit: "
7459     "  R>A "
7460     "  ( final 0: our counter is 0 here, so use it ) "
7461     "  C, ALIGN-HERE "
7462     "$strlit-exit: "
7463     ";");
7464
7465   // quote
7466   // ( -- addr count )
7467   ufoInterpretLine(
7468     "!: \"  ( -- addr count ) "
7469     "  34 PARSE ` string literal expected` ?NOT-ERROR "
7470     "  COMPILER:(UNESCAPE) STRLITERAL "
7471     ";");
7472 }
7473
7474
7475 //==========================================================================
7476 //
7477 //  ufoDefineInterpret
7478 //
7479 //  define "INTERPRET" in Forth
7480 //
7481 //==========================================================================
7482 UFO_DISABLE_INLINE void ufoDefineInterpret (void) {
7483   UFWORDX("(UFO-INTERPRET-FINISHED-ACTION)", UFO_INTERPRET_FINISHED_ACTION);
7484
7485   // return "stop flag"
7486   ufoInterpretLine(
7487     "*: (UFO-INTERPRET-NEXT-LINE)  ( -- continue? ) "
7488     "  STATE @ FORTH:(TBRANCH) $ipn_incomp "
7489     "    ( interpreter allowed to cross include boundary ) "
7490     "    REFILL FORTH:(BRANCH) $ipn_done "
7491     "$ipn_incomp: "
7492     "    ( compiler is not allowed to cross include boundary ) "
7493     "    REFILL-NOCROSS ` compiler cannot cross file boundaries` ?NOT-ERROR "
7494     "    TRUE "
7495     "$ipn_done: "
7496     ";");
7497
7498   ufoInterpNextLineCFA = ufoFindWordChecked("FORTH:(UFO-INTERPRET-NEXT-LINE)");
7499   ufoInterpretLine("*: (INTERPRET-NEXT-LINE)  (USER-INTERPRET-NEXT-LINE) @ EXECUTE-TAIL ;");
7500
7501   // skip comments, parse name, refilling lines if necessary
7502   // returning FALSE as counter means: "no addr, exit INTERPRET"
7503   ufoInterpretLine(
7504     "*: (INTERPRET-PARSE-NAME)  ( -- addr count / FALSE ) "
7505     "$label_ipn_again: "
7506     "  TRUE (PARSE-SKIP-COMMENTS) PARSE-NAME "
7507     "  DUP FORTH:(TBRANCH) $label_ipn_exit_fwd "
7508     "  2DROP (INTERPRET-NEXT-LINE) "
7509     "  FORTH:(TBRANCH) $label_ipn_again "
7510     "  FALSE "
7511     "$label_ipn_exit_fwd: "
7512     ";");
7513   //ufoDecompileWord(ufoFindWordChecked("(INTERPRET-PARSE-NAME)"));
7514
7515   ufoInterpretLine(
7516     ": INTERPRET "
7517     "$interp-again: "
7518     "  FORTH:(INTERPRET-PARSE-NAME) ( addr count / FALSE )"
7519     "  ?DUP FORTH:(0BRANCH) $interp-done "
7520     "  ( try defered checker ) "
7521     "  ( addr count FALSE -- addr count FALSE / TRUE ) "
7522     "  FALSE (INTERPRET-CHECK-WORD) FORTH:(TBRANCH) $interp-again "
7523     "  2DUP FIND-WORD  ( addr count cfa TRUE / addr count FALSE ) "
7524     "  FORTH:(0BRANCH) $interp-try-number "
7525     "  ( word found ) "
7526     "  NROT 2DROP  ( drop word string ) "
7527     "  STATE @ FORTH:(0BRANCH) $interp-exec "
7528     "  ( compiling; check immediate bit ) "
7529     "  DUP CFA->NFA @ COMPILER:(WFLAG-IMMEDIATE) AND FORTH:(TBRANCH) $interp-exec "
7530     "  ( compile it ) "
7531     "  FORTH:COMPILE, FORTH:(BRANCH) $interp-again "
7532     "  ( execute it ) "
7533     "$interp-exec: "
7534     "  EXECUTE FORTH:(BRANCH) $interp-again "
7535     "  ( not a word, try a number ) "
7536     "$interp-try-number: "
7537     "  2DUP TRUE BASE @ (BASED-NUMBER)  ( addr count allowsign? base -- num TRUE / FALSE ) "
7538     "  FORTH:(0BRANCH) $interp-number-error "
7539     "  ( number ) "
7540     "  NROT 2DROP  ( drop word string ) "
7541     "  ( do we need to compile it? ) "
7542     "  STATE @ FORTH:(0BRANCH) $interp-again "
7543     "  COMPILE FORTH:(LIT) FORTH:, "
7544     "  FORTH:(BRANCH) $interp-again "
7545     "  ( error ) "
7546     "$interp-number-error: "
7547     "  ( addr count FALSE -- addr count FALSE / TRUE ) "
7548     "  FALSE (INTERPRET-WORD-NOT-FOUND) FORTH:(TBRANCH) $interp-again "
7549     "  ENDCR SPACE XTYPE `  -- wut?` TYPE CR "
7550     "  ` unknown word` ERROR "
7551     "$interp-done: "
7552     ";");
7553   //ufoDecompileWord(ufoFindWordChecked("INTERPRET"));
7554 }
7555
7556
7557 //==========================================================================
7558 //
7559 //  ufoInitBaseDict
7560 //
7561 //==========================================================================
7562 UFO_DISABLE_INLINE void ufoInitBaseDict (void) {
7563   uint32_t imgAddr = 0;
7564
7565   // reserve 32 bytes for nothing
7566   for (uint32_t f = 0; f < 32; f += 1) {
7567     ufoImgPutU8(imgAddr, 0);
7568     imgAddr += 1;
7569   }
7570   // align
7571   while ((imgAddr & 3) != 0) {
7572     ufoImgPutU8(imgAddr, 0);
7573     imgAddr += 1;
7574   }
7575
7576   // DP
7577   ufoAddrDP = imgAddr;
7578   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
7579
7580   // DP-TEMP
7581   ufoAddrDPTemp = imgAddr;
7582   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
7583
7584   // (LATEST-XFA)
7585   ufoAddrLastXFA = imgAddr;
7586   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
7587
7588   // (VOC-LINK)
7589   ufoAddrVocLink = imgAddr;
7590   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
7591
7592   // (NEW-WORD-FLAGS)
7593   ufoAddrNewWordFlags = imgAddr;
7594   ufoImgPutU32(imgAddr, UFW_FLAG_PROTECTED); imgAddr += 4u;
7595
7596   // WORD-REDEFINE-WARN-MODE
7597   ufoAddrRedefineWarning = imgAddr;
7598   ufoImgPutU32(imgAddr, UFO_REDEF_WARN_NORMAL); imgAddr += 4u;
7599
7600   // setup (DP) and (DP-TEMP)
7601   ufoImgPutU32(ufoAddrDP, imgAddr);
7602   ufoImgPutU32(ufoAddrDPTemp, 0);
7603
7604   #if 0
7605   fprintf(stderr, "INITIAL HERE: 0x%08x (0x%08x)\n", imgAddr, UFO_GET_DP());
7606   #endif
7607 }
7608
7609
7610 //==========================================================================
7611 //
7612 //  ufoInitStateUserVars
7613 //
7614 //==========================================================================
7615 static void ufoInitStateUserVars (UfoState *st, uint32_t cfa) {
7616   ufo_assert(st != NULL);
7617   if (st->imageTempSize < 8192u) {
7618     uint32_t *itmp = realloc(st->imageTemp, 8192);
7619     if (itmp == NULL) ufoFatal("out of memory for state user area");
7620     st->imageTemp = itmp;
7621     memset((uint8_t *)st->imageTemp + st->imageTempSize, 0, 8192u - st->imageTempSize);
7622     st->imageTempSize = 8192;
7623   }
7624   st->imageTemp[(ufoAddrBASE & UFO_ADDR_TEMP_MASK) / 4u] = 10;
7625   st->imageTemp[(ufoAddrSTATE & UFO_ADDR_TEMP_MASK) / 4u] = 0;
7626   st->imageTemp[(ufoAddrUserVarUsed & UFO_ADDR_TEMP_MASK) / 4u] = ufoAddrUserVarUsed;
7627   st->imageTemp[(ufoAddrDefTIB & UFO_ADDR_TEMP_MASK) / 4u] = UFO_DEF_TIB_ADDR;
7628   st->imageTemp[(ufoAddrTIBx & UFO_ADDR_TEMP_MASK) / 4u] = UFO_DEF_TIB_ADDR;
7629   st->imageTemp[(ufoAddrINx & UFO_ADDR_TEMP_MASK) / 4u] = 0;
7630   st->imageTemp[(ufoAddrContext & UFO_ADDR_TEMP_MASK) / 4u] = ufoForthVocId;
7631   st->imageTemp[(ufoAddrCurrent & UFO_ADDR_TEMP_MASK) / 4u] = ufoForthVocId;
7632   st->imageTemp[(ufoAddrSelf & UFO_ADDR_TEMP_MASK) / 4u] = 0;
7633   st->imageTemp[(ufoAddrInterNextLine & UFO_ADDR_TEMP_MASK) / 4u] = ufoInterpNextLineCFA;
7634   st->imageTemp[(ufoAddrEP & UFO_ADDR_TEMP_MASK) / 4u] = 0;
7635   // init other things, because this procedure is used in `ufoReset()` too
7636   st->SP = 0; st->RP = 0; st->RPTop = 0; st->regA = 0;
7637   st->LP = 0; st->LBP = 0; st->vmRPopCFA = 0;
7638   st->VSP = 0;
7639   // init it
7640   if (cfa != 0) {
7641     st->vmRPopCFA = 1;
7642     st->rStack[0] = 0xdeadf00d; // dummy value
7643     st->rStack[1] = cfa;
7644     st->RP = 2;
7645   }
7646 }
7647
7648
7649 //==========================================================================
7650 //
7651 //  ufoInitBasicWords
7652 //
7653 //==========================================================================
7654 UFO_DISABLE_INLINE void ufoInitBasicWords (void) {
7655   ufoDefineConstant("FALSE", 0);
7656   ufoDefineConstant("TRUE", ufoTrueValue);
7657
7658   ufoDefineConstant("BL", 32);
7659   ufoDefineConstant("NL", 10);
7660
7661   // user variables
7662   ufoDefineUserVar("BASE", ufoAddrBASE);
7663   ufoDefineUserVar("TIB", ufoAddrTIBx);
7664   ufoDefineUserVar(">IN", ufoAddrINx);
7665   ufoDefineUserVar("(STD-TIB-ADDR)", ufoAddrDefTIB);
7666   ufoDefineUserVar("(USER-VAR-USED)", ufoAddrUserVarUsed);
7667   ufoDefineConstant("(USER-VAR-ADDR)", UFO_ADDR_TEMP_BIT);
7668   ufoDefineConstant("(USER-VAR-SIZE)", UFO_USER_AREA_SIZE);
7669   ufoDefineConstant("(USER-TIB)", UFO_DEF_TIB_ADDR);
7670   ufoDefineConstant("(USER-TIB-SIZE)", UFO_ADDR_HANDLE_OFS_MASK);
7671
7672   ufoDefineUserVar("STATE", ufoAddrSTATE);
7673   ufoDefineConstant("CONTEXT", ufoAddrContext);
7674   ufoDefineConstant("CURRENT", ufoAddrCurrent);
7675   ufoDefineConstant("(SELF)", ufoAddrSelf); // used in OOP implementations
7676   ufoDefineConstant("(USER-INTERPRET-NEXT-LINE)", ufoAddrInterNextLine);
7677   ufoDefineConstant("(EXC-FRAME-PTR)", ufoAddrEP);
7678
7679   ufoHiddenWords();
7680   ufoDefineConstant("(LATEST-XFA)", ufoAddrLastXFA);
7681   ufoDefineConstant("(VOC-LINK)", ufoAddrVocLink);
7682   ufoDefineConstant("(NEW-WORD-FLAGS)", ufoAddrNewWordFlags);
7683   ufoDefineConstant("(ADDR-TEMP-BIT)", UFO_ADDR_TEMP_BIT);
7684   ufoDefineConstant("(ADDR-CFA-BIT)", UFO_ADDR_CFA_BIT);
7685   ufoDefineConstant("(ADDR-HANDLE-BIT)", UFO_ADDR_HANDLE_BIT);
7686   ufoDefineConstant("(MAX-HANDLE-OFS)", UFO_ADDR_HANDLE_OFS_MASK);
7687
7688   ufoDefineConstant("(PAD-ADDR)", UFO_PAD_ADDR);
7689   ufoDefineConstant("(#BUF)", UFO_NBUF_ADDR + 4u); // reserve room for counter
7690   ufoDefineConstant("(#BUF-SIZE)", UFO_NBUF_SIZE - 8u);
7691
7692   ufoDefineConstant("(DP)", ufoAddrDP);
7693   ufoDefineConstant("(DP-TEMP)", ufoAddrDPTemp);
7694   ufoPublicWords();
7695
7696   //UFWORDX("(UFO-BUCKET-STATS)", PAR_UFO_BUCKET_STATS);
7697   UFWORDX("SP0!", SP0_STORE);
7698   UFWORDX("RP0!", RP0_STORE);
7699
7700   UFWORDX("PAD", PAD);
7701
7702   UFWORDX("@", PEEK);
7703   UFWORDX("C@", CPEEK);
7704   UFWORDX("W@", WPEEK);
7705
7706   UFWORDX("!", POKE);
7707   UFWORDX("C!", CPOKE);
7708   UFWORDX("W!", WPOKE);
7709
7710   UFWORDX(",", COMMA);
7711   UFWORDX("C,", CCOMMA);
7712   UFWORDX("W,", WCOMMA);
7713
7714   UFWORDX("A>", REGA_LOAD);
7715   UFWORDX(">A", REGA_STORE);
7716   UFWORDX("A-SWAP", REGA_SWAP);
7717   UFWORDX("+1>A", REGA_INC);
7718   UFWORDX("+4>A", REGA_INC_CELL);
7719   UFWORDX("A>R", REGA_TO_R);
7720   UFWORDX("R>A", R_TO_REGA);
7721
7722   UFWORDX("@A+", PEEK_REGA_IDX);
7723   UFWORDX("C@A+", CPEEK_REGA_IDX);
7724   UFWORDX("W@A+", WPEEK_REGA_IDX);
7725
7726   UFWORDX("!A+", POKE_REGA_IDX);
7727   UFWORDX("C!A+", CPOKE_REGA_IDX);
7728   UFWORDX("W!A+", WPOKE_REGA_IDX);
7729
7730   ufoHiddenWords();
7731   UFWORDX("(LIT)", PAR_LIT); ufoSetLatestArgs(UFW_WARG_LIT);
7732   UFWORDX("(LITCFA)", PAR_LITCFA); ufoSetLatestArgs(UFW_WARG_CFA);
7733   UFWORDX("(LITVOCID)", PAR_LITVOCID); ufoSetLatestArgs(UFW_WARG_VOCID);
7734   UFWORDX("(LITSTR8)", PAR_LITSTR8); ufoSetLatestArgs(UFW_WARG_C1STRZ);
7735   UFWORDX("(EXIT)", PAR_EXIT);
7736
7737   ufoLitStr8CFA = ufoFindWordChecked("FORTH:(LITSTR8)");
7738
7739   UFWORDX("(L-ENTER)", PAR_LENTER); ufoSetLatestArgs(UFW_WARG_LIT);
7740   UFWORDX("(L-LEAVE)", PAR_LLEAVE);
7741   UFWORDX("(LOCAL@)", PAR_LOCAL_LOAD);
7742   UFWORDX("(LOCAL!)", PAR_LOCAL_STORE);
7743
7744   UFWORDX("(BRANCH)", PAR_BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7745   UFWORDX("(TBRANCH)", PAR_TBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7746   UFWORDX("(0BRANCH)", PAR_0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7747   UFWORDX("(+0BRANCH)", PAR_P0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7748   UFWORDX("(+BRANCH)", PAR_PBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7749   UFWORDX("(-0BRANCH)", PAR_M0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7750   UFWORDX("(-BRANCH)", PAR_MBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
7751   UFWORDX("(DATASKIP)", PAR_DATASKIP); ufoSetLatestArgs(UFW_WARG_DATASKIP);
7752   ufoPublicWords();
7753 }
7754
7755
7756 //==========================================================================
7757 //
7758 //  ufoInitBasicCompilerWords
7759 //
7760 //==========================================================================
7761 UFO_DISABLE_INLINE void ufoInitBasicCompilerWords (void) {
7762   // create "COMPILER" vocabulary
7763   ufoCompilerVocId = ufoCreateVoc("COMPILER", 0, UFW_FLAG_PROTECTED);
7764   ufoVocSetOnlyDefs(ufoCompilerVocId);
7765
7766   ufoDefineConstant("(CFAIDX-DO-FORTH)", ufoDoForthCFA);
7767   ufoDefineConstant("(CFAIDX-DO-VAR)", ufoDoVariableCFA);
7768   ufoDefineConstant("(CFAIDX-DO-VALUE)", ufoDoValueCFA);
7769   ufoDefineConstant("(CFAIDX-DO-CONST)", ufoDoConstCFA);
7770   ufoDefineConstant("(CFAIDX-DO-DEFER)", ufoDoDeferCFA);
7771   ufoDefineConstant("(CFAIDX-DO-VOC)", ufoDoVocCFA);
7772   ufoDefineConstant("(CFAIDX-DO-CREATE)", ufoDoCreateCFA);
7773   ufoDefineConstant("(CFAIDX-DO-USER-VAR)", ufoDoUserVariableCFA);
7774
7775   ufoDefineConstant("(WFLAG-IMMEDIATE)", UFW_FLAG_IMMEDIATE);
7776   ufoDefineConstant("(WFLAG-SMUDGE)", UFW_FLAG_SMUDGE);
7777   ufoDefineConstant("(WFLAG-NORETURN)", UFW_FLAG_NORETURN);
7778   ufoDefineConstant("(WFLAG-HIDDEN)", UFW_FLAG_HIDDEN);
7779   ufoDefineConstant("(WFLAG-CBLOCK)", UFW_FLAG_CBLOCK);
7780   ufoDefineConstant("(WFLAG-VOCAB)", UFW_FLAG_VOCAB);
7781   ufoDefineConstant("(WFLAG-SCOLON)", UFW_FLAG_SCOLON);
7782   ufoDefineConstant("(WFLAG-PROTECTED)", UFW_FLAG_PROTECTED);
7783
7784   ufoDefineConstant("(WARG-MASK)", UFW_WARG_MASK);
7785   ufoDefineConstant("(WARG-NONE)", UFW_WARG_NONE);
7786   ufoDefineConstant("(WARG-BRANCH)", UFW_WARG_BRANCH);
7787   ufoDefineConstant("(WARG-LIT)", UFW_WARG_LIT);
7788   ufoDefineConstant("(WARG-C4STRZ)", UFW_WARG_C4STRZ);
7789   ufoDefineConstant("(WARG-CFA)", UFW_WARG_CFA);
7790   ufoDefineConstant("(WARG-CBLOCK)", UFW_WARG_CBLOCK);
7791   ufoDefineConstant("(WARG-VOCID)", UFW_WARG_VOCID);
7792   ufoDefineConstant("(WARG-C1STRZ)", UFW_WARG_C1STRZ);
7793
7794   ufoDefineConstant("(VOCOFS-LATEST)", UFW_VOCAB_OFS_LATEST);
7795   ufoDefineConstant("(VOCOFS-VOCLINK)", UFW_VOCAB_OFS_VOCLINK);
7796   ufoDefineConstant("(VOCOFS-PARENT)", UFW_VOCAB_OFS_PARENT);
7797   ufoDefineConstant("(VOCOFS-HEADER)", UFW_VOCAB_OFS_HEADER);
7798   ufoDefineConstant("(VOCOFS-HTABLE)", UFW_VOCAB_OFS_HTABLE);
7799   ufoDefineConstant("(VOC-HTABLE-SIZE)", UFO_HASHTABLE_SIZE);
7800   ufoDefineConstant("(VOC-HTABLE-NOFLAG)", UFO_NO_HTABLE_FLAG);
7801
7802   ufoDefineConstant("(REDEFINE-WARN-DON'T-CARE)", UFO_REDEF_WARN_DONT_CARE);
7803   ufoDefineConstant("(REDEFINE-WARN-NONE)", UFO_REDEF_WARN_NONE);
7804   ufoDefineConstant("(REDEFINE-WARN-NORMAL)", UFO_REDEF_WARN_NORMAL);
7805   ufoDefineConstant("(REDEFINE-WARN-PARENTS)", UFO_REDEF_WARN_PARENTS);
7806
7807   ufoDefineConstant("WORD-REDEFINE-WARN-MODE", ufoAddrRedefineWarning);
7808
7809   UFWORDX("(UNESCAPE)", PAR_UNESCAPE);
7810
7811   ufoInterpretLine(
7812     ": ?EXEC  ( -- ) "
7813     "  FORTH:STATE FORTH:@ ` expecting interpretation mode` FORTH:?ERROR "
7814     ";");
7815
7816   ufoInterpretLine(
7817     ": ?COMP  ( -- ) "
7818     "  FORTH:STATE FORTH:@ ` expecting compilation mode` FORTH:?NOT-ERROR "
7819     ";");
7820
7821   UFWORDX("(CREATE-WORD-HEADER)", PAR_CREATE_WORD_HEADER);
7822   UFWORDX("(CREATE-NAMELESS-WORD-HEADER)", PAR_CREATE_NAMELESS_WORD_HEADER);
7823
7824   ufoVocSetOnlyDefs(ufoForthVocId);
7825
7826   // [
7827   ufoInterpretLine("!: [  COMPILER:?COMP 0 STATE ! ;");
7828   // ]
7829   ufoInterpretLine(": ]  COMPILER:?EXEC 1 STATE ! ;");
7830 }
7831
7832
7833 //==========================================================================
7834 //
7835 //  ufoInitMoreWords
7836 //
7837 //==========================================================================
7838 UFO_DISABLE_INLINE void ufoInitMoreWords (void) {
7839   UFWORDX("COMPILE,", COMMA); // just an alias, for clarity
7840
7841   UFWORDX("CFA->PFA", CFA2PFA);
7842   UFWORDX("CFA->NFA", CFA2NFA);
7843   UFWORDX("CFA->LFA", CFA2LFA);
7844   UFWORDX("CFA->WEND", CFA2WEND);
7845
7846   UFWORDX("PFA->CFA", PFA2CFA);
7847   UFWORDX("PFA->NFA", PFA2NFA);
7848
7849   UFWORDX("NFA->CFA", NFA2CFA);
7850   UFWORDX("NFA->PFA", NFA2PFA);
7851   UFWORDX("NFA->LFA", NFA2LFA);
7852
7853   UFWORDX("LFA->CFA", LFA2CFA);
7854   UFWORDX("LFA->PFA", LFA2PFA);
7855   UFWORDX("LFA->BFA", LFA2BFA);
7856   UFWORDX("LFA->XFA", LFA2XFA);
7857   UFWORDX("LFA->YFA", LFA2YFA);
7858   UFWORDX("LFA->NFA", LFA2NFA);
7859
7860   UFWORDX("(BASED-NUMBER)", PAR_BASED_NUMBER);
7861   UFWORDX("FIND-WORD", FIND_WORD);
7862   UFWORDX("(FIND-WORD-IN-VOC)", FIND_WORD_IN_VOC);
7863   UFWORDX("(FIND-WORD-IN-VOC-AND-PARENTS)", FIND_WORD_IN_VOC_AND_PARENTS);
7864
7865   UFWORD(EXECUTE);
7866   UFWORDX("EXECUTE-TAIL", EXECUTE_TAIL);
7867
7868   UFWORD(DUP);
7869   UFWORDX("?DUP", QDUP);
7870   UFWORDX("2DUP", DDUP);
7871   UFWORD(DROP);
7872   UFWORDX("2DROP", DDROP);
7873   UFWORD(SWAP);
7874   UFWORDX("2SWAP", DSWAP);
7875   UFWORD(OVER);
7876   UFWORDX("2OVER", DOVER);
7877   UFWORD(ROT);
7878   UFWORD(NROT);
7879   UFWORDX("PICK", PICK);
7880   UFWORDX("ROLL", ROLL);
7881
7882   UFWORD(RDUP);
7883   UFWORD(RDROP);
7884   UFWORDX(">R", DTOR);
7885   UFWORDX("R>", RTOD);
7886   UFWORDX("R@", RPEEK);
7887   UFWORDX("RPICK", RPICK);
7888   UFWORDX("RROLL", RROLL);
7889   UFWORDX("RSWAP", RSWAP);
7890   UFWORDX("ROVER", ROVER);
7891   UFWORDX("RROT", RROT);
7892   UFWORDX("RNROT", RNROT);
7893
7894   UFWORDX("FLUSH-EMIT", FLUSH_EMIT);
7895   UFWORDX("(EMIT)", PAR_EMIT);
7896   UFWORDX("(NORM-EMIT-CHAR)", PAR_NORM_EMIT_CHAR);
7897   UFWORDX("(NORM-XEMIT-CHAR)", PAR_NORM_XEMIT_CHAR);
7898   UFWORDX("LASTCR?", LASTCRQ);
7899   UFWORDX("LASTCR!", LASTCRSET);
7900
7901   // simple math
7902   UFWORDX("+", PLUS);
7903   UFWORDX("-", MINUS);
7904   UFWORDX("*", MUL);
7905   UFWORDX("U*", UMUL);
7906   UFWORDX("/", DIV);
7907   UFWORDX("U/", UDIV);
7908   UFWORDX("MOD", MOD);
7909   UFWORDX("UMOD", UMOD);
7910   UFWORDX("/MOD", DIVMOD);
7911   UFWORDX("U/MOD", UDIVMOD);
7912   UFWORDX("*/", MULDIV);
7913   UFWORDX("U*/", UMULDIV);
7914   UFWORDX("*/MOD", MULDIVMOD);
7915   UFWORDX("U*/MOD", UMULDIVMOD);
7916   UFWORDX("M*", MMUL);
7917   UFWORDX("UM*", UMMUL);
7918   UFWORDX("M/MOD", MDIVMOD);
7919   UFWORDX("UM/MOD", UMDIVMOD);
7920   UFWORDX("UDS*", UDSMUL);
7921
7922   UFWORDX("SM/REM", SMREM);
7923   UFWORDX("FM/MOD", FMMOD);
7924
7925   UFWORDX("D-", DMINUS);
7926   UFWORDX("D+", DPLUS);
7927   UFWORDX("D=", DEQU);
7928   UFWORDX("D<", DLESS);
7929   UFWORDX("D<=", DLESSEQU);
7930   UFWORDX("DU<", DULESS);
7931   UFWORDX("DU<=", DULESSEQU);
7932
7933   UFWORD(ASH);
7934   UFWORD(LSH);
7935
7936   // logic
7937   UFWORDX("<", LESS);
7938   UFWORDX(">", GREAT);
7939   UFWORDX("<=", LESSEQU);
7940   UFWORDX(">=", GREATEQU);
7941   UFWORDX("U<", ULESS);
7942   UFWORDX("U>", UGREAT);
7943   UFWORDX("U<=", ULESSEQU);
7944   UFWORDX("U>=", UGREATEQU);
7945   UFWORDX("=", EQU);
7946   UFWORDX("<>", NOTEQU);
7947
7948   UFWORDX("0=", ZERO_EQU);
7949   UFWORDX("0<>", ZERO_NOTEQU);
7950
7951   UFWORDX("NOT", ZERO_EQU);
7952   UFWORDX("NOTNOT", ZERO_NOTEQU);
7953
7954   UFWORD(BITNOT);
7955   UFWORD(AND);
7956   UFWORD(OR);
7957   UFWORD(XOR);
7958   UFWORDX("LOGAND", LOGAND);
7959   UFWORDX("LOGOR", LOGOR);
7960
7961   // TIB and parser
7962   UFWORDX("(TIB-IN)", TIB_IN);
7963   UFWORDX("TIB-PEEKCH", TIB_PEEKCH);
7964   UFWORDX("TIB-PEEKCH-OFS", TIB_PEEKCH_OFS);
7965   UFWORDX("TIB-GETCH", TIB_GETCH);
7966   UFWORDX("TIB-SKIPCH", TIB_SKIPCH);
7967
7968   UFWORDX("REFILL", REFILL);
7969   UFWORDX("REFILL-NOCROSS", REFILL_NOCROSS);
7970
7971   ufoHiddenWords();
7972   UFWORDX("(PARSE)", PAR_PARSE);
7973   UFWORDX("(PARSE-SKIP-COMMENTS)", PAR_PARSE_SKIP_COMMENTS);
7974   ufoPublicWords();
7975   UFWORDX("PARSE-SKIP-BLANKS", PARSE_SKIP_BLANKS);
7976   UFWORDX("PARSE-NAME", PARSE_NAME);
7977   UFWORDX("PARSE-SKIP-LINE", PARSE_SKIP_LINE);
7978   UFWORDX("PARSE", PARSE);
7979
7980   ufoHiddenWords();
7981   UFWORDX("(VSP@)", PAR_GET_VSP);
7982   UFWORDX("(VSP!)", PAR_SET_VSP);
7983   UFWORDX("(VSP-AT@)", PAR_VSP_LOAD);
7984   UFWORDX("(VSP-AT!)", PAR_VSP_STORE);
7985   ufoDefineConstant("(VSP-SIZE)", UFO_VOCSTACK_SIZE);
7986
7987   ufoDefineConstant("(SP-SIZE)", UFO_DSTACK_SIZE);
7988   ufoDefineConstant("(RP-SIZE)", UFO_RSTACK_SIZE);
7989   ufoDefineConstant("(LP-SIZE)", UFO_LSTACK_SIZE);
7990   ufoPublicWords();
7991
7992   UFWORDX("ERROR", ERROR);
7993   UFWORDX("FATAL-ERROR", ERROR);
7994
7995   ufoInterpretLine(": 1+  ( n -- n+1 )  1 + ;");
7996   ufoInterpretLine(": 1-  ( n -- n-1 )  1 - ;");
7997   ufoInterpretLine(": 2+  ( n -- n+2 )  2 + ;");
7998   ufoInterpretLine(": 2-  ( n -- n-2 )  2 - ;");
7999   ufoInterpretLine(": 4+  ( n -- n+4 )  4 + ;");
8000   ufoInterpretLine(": 4-  ( n -- n-4 )  4 - ;");
8001
8002   ufoInterpretLine(": 2*  ( n -- n*2 )  1 ASH ;");
8003   ufoInterpretLine(": 2/  ( n -- n/2 )  -1 ASH ;");
8004   ufoInterpretLine(": 4*  ( n -- n*4 )  2 ASH ;");
8005   ufoInterpretLine(": 4/  ( n -- n/4 )  -2 ASH ;");
8006
8007   ufoInterpretLine(": 2U*  ( u -- u*2 )  1 LSH ;");
8008   ufoInterpretLine(": 2U/  ( u -- u/2 )  -1 LSH ;");
8009   ufoInterpretLine(": 4U*  ( u -- u*4 )  2 LSH ;");
8010   ufoInterpretLine(": 4U/  ( u -- u/4 )  -2 LSH ;");
8011
8012   ufoInterpretLine(": 0<  ( n -- n<0 )  0 < ;");
8013   ufoInterpretLine(": 0>  ( n -- n>0 )  0 > ;");
8014   ufoInterpretLine(": 0<=  ( n -- n<0 )  0 <= ;");
8015   ufoInterpretLine(": 0>=  ( n -- n>0 )  0 >= ;");
8016
8017   ufoInterpretLine(": @A  ( idx -- v )  0 @A+ ;");
8018   ufoInterpretLine(": C@A  ( idx -- v )  0 C@A+ ;");
8019   ufoInterpretLine(": W@A  ( idx -- v )  0 W@A+ ;");
8020
8021   ufoInterpretLine(": !A  ( idx -- v )  0 !A+ ;");
8022   ufoInterpretLine(": C!A  ( idx -- v )  0 C!A+ ;");
8023   ufoInterpretLine(": W!A  ( idx -- v )  0 W!A+ ;");
8024
8025   // ABORT
8026   // ( -- )
8027   ufoInterpretLine(": ABORT  ` \"ABORT\" called` ERROR ;");
8028
8029   // ?ERROR
8030   // ( errflag addr count -- )
8031   ufoInterpretLine(
8032     ": ?ERROR  ( errflag addr count -- ) "
8033     "  ROT FORTH:(0BRANCH) $qerr_skip ERROR "
8034     "$qerr_skip: "
8035     "  2DROP "
8036     ";");
8037
8038   // ?NOT-ERROR
8039   // ( errflag addr count -- )
8040   ufoInterpretLine(
8041     ": ?NOT-ERROR  ( errflag addr count -- ) "
8042     "  ROT FORTH:(TBRANCH) $qnoterr_skip ERROR "
8043     "$qnoterr_skip: "
8044     "  2DROP "
8045     ";");
8046
8047   ufoInterpretLine(
8048     ": FIND-WORD-IN-VOC  ( vocid addr count -- cfa TRUE / FALSE ) "
8049     "  0 (FIND-WORD-IN-VOC) ;");
8050
8051   ufoInterpretLine(
8052     ": FIND-WORD-IN-VOC-AND-PARENTS ( vocid addr count -- cfa TRUE / FALSE ) "
8053     "  0 (FIND-WORD-IN-VOC-AND-PARENTS) ;");
8054
8055   UFWORDX("GET-MSECS", GET_MSECS);
8056 }
8057
8058
8059 //==========================================================================
8060 //
8061 //  ufoInitHandleWords
8062 //
8063 //==========================================================================
8064 UFO_DISABLE_INLINE void ufoInitHandleWords (void) {
8065   // create "HANDLE" vocabulary
8066   const uint32_t handleVocId = ufoCreateVoc("HANDLE", 0, UFW_FLAG_PROTECTED);
8067   ufoVocSetOnlyDefs(handleVocId);
8068   UFWORDX("NEW", PAR_NEW_HANDLE);
8069   UFWORDX("FREE", PAR_FREE_HANDLE);
8070   UFWORDX("TYPEID@", PAR_HANDLE_GET_TYPEID);
8071   UFWORDX("TYPEID!", PAR_HANDLE_SET_TYPEID);
8072   UFWORDX("SIZE@", PAR_HANDLE_GET_SIZE);
8073   UFWORDX("SIZE!", PAR_HANDLE_SET_SIZE);
8074   UFWORDX("USED@", PAR_HANDLE_GET_USED);
8075   UFWORDX("USED!", PAR_HANDLE_SET_USED);
8076   UFWORDX("C@", PAR_HANDLE_LOAD_BYTE);
8077   UFWORDX("W@", PAR_HANDLE_LOAD_WORD);
8078   UFWORDX("@", PAR_HANDLE_LOAD_CELL);
8079   UFWORDX("C!", PAR_HANDLE_STORE_BYTE);
8080   UFWORDX("W!", PAR_HANDLE_STORE_WORD);
8081   UFWORDX("!", PAR_HANDLE_STORE_CELL);
8082   UFWORDX("LOAD-FILE", PAR_HANDLE_LOAD_FILE);
8083   ufoVocSetOnlyDefs(ufoForthVocId);
8084 }
8085
8086
8087 //==========================================================================
8088 //
8089 //  ufoInitHigherWords
8090 //
8091 //==========================================================================
8092 UFO_DISABLE_INLINE void ufoInitHigherWords (void) {
8093   UFWORDX("(INCLUDE)", PAR_INCLUDE);
8094
8095   UFWORDX("(INCLUDE-DEPTH)", PAR_INCLUDE_DEPTH);
8096   UFWORDX("(INCLUDE-FILE-ID)", PAR_INCLUDE_FILE_ID);
8097   UFWORDX("(INCLUDE-FILE-LINE)", PAR_INCLUDE_FILE_LINE);
8098   UFWORDX("(INCLUDE-FILE-NAME)", PAR_INCLUDE_FILE_NAME);
8099
8100   UFWORDX("($DEFINED?)", PAR_DLR_DEFINEDQ);
8101   UFWORDX("($DEFINE)", PAR_DLR_DEFINE);
8102   UFWORDX("($UNDEF)", PAR_DLR_UNDEF);
8103
8104   UFWORDX_IMM("$INCLUDE", DLR_INCLUDE_IMM);
8105   UFWORDX_IMM("$INCLUDE-ONCE", DLR_INCLUDE_ONCE_IMM);
8106 }
8107
8108
8109 //==========================================================================
8110 //
8111 //  ufoInitStringWords
8112 //
8113 //==========================================================================
8114 UFO_DISABLE_INLINE void ufoInitStringWords (void) {
8115   // create "STRING" vocabulary
8116   const uint32_t stringVocId = ufoCreateVoc("STRING", 0, UFW_FLAG_PROTECTED);
8117   ufoVocSetOnlyDefs(stringVocId);
8118   UFWORDX("=", STREQU);
8119   UFWORDX("=CI", STREQUCI);
8120   UFWORDX("SEARCH", SEARCH);
8121   UFWORDX("HASH", STRHASH);
8122   UFWORDX("HASH-CI", STRHASHCI);
8123   ufoVocSetOnlyDefs(ufoForthVocId);
8124 }
8125
8126
8127 //==========================================================================
8128 //
8129 //  ufoInitDebugWords
8130 //
8131 //==========================================================================
8132 UFO_DISABLE_INLINE void ufoInitDebugWords (void) {
8133   // create "DEBUG" vocabulary
8134   const uint32_t debugVocId = ufoCreateVoc("DEBUG", 0, UFW_FLAG_PROTECTED);
8135   ufoVocSetOnlyDefs(debugVocId);
8136   UFWORDX("(DECOMPILE-CFA)", DEBUG_DECOMPILE_CFA);
8137   UFWORDX("(DECOMPILE-MEM)", DEBUG_DECOMPILE_MEM);
8138   UFWORDX("BACKTRACE", UFO_BACKTRACE);
8139   UFWORDX("DUMP-STACK", DUMP_STACK);
8140   UFWORDX("BACKTRACE-TASK", UFO_BACKTRACE_TASK);
8141   UFWORDX("DUMP-STACK-TASK", DUMP_STACK_TASK);
8142   UFWORDX("DUMP-RSTACK-TASK", DUMP_RSTACK_TASK);
8143   UFWORDX("(BP)", MT_DEBUGGER_BP);
8144   UFWORDX("IP->NFA", IP2NFA);
8145   UFWORDX("IP->FILE/LINE", IP2FILELINE);
8146   UFWORDX("IP->FILE-HASH/LINE", IP2FILEHASHLINE);
8147   ufoVocSetOnlyDefs(ufoForthVocId);
8148 }
8149
8150
8151 //==========================================================================
8152 //
8153 //  ufoInitMTWords
8154 //
8155 //==========================================================================
8156 UFO_DISABLE_INLINE void ufoInitMTWords (void) {
8157   // create "MTASK" vocabulary
8158   const uint32_t mtVocId = ufoCreateVoc("MTASK", 0, UFW_FLAG_PROTECTED);
8159   ufoVocSetOnlyDefs(mtVocId);
8160   UFWORDX("NEW-STATE", MT_NEW_STATE);
8161   UFWORDX("FREE-STATE", MT_FREE_STATE);
8162   UFWORDX("STATE-NAME@", MT_GET_STATE_NAME);
8163   UFWORDX("STATE-NAME!", MT_SET_STATE_NAME);
8164   UFWORDX("STATE-FIRST", MT_STATE_FIRST);
8165   UFWORDX("STATE-NEXT", MT_STATE_NEXT);
8166   UFWORDX("YIELD-TO", MT_YIELD_TO);
8167   UFWORDX("SET-SELF-AS-DEBUGGER", MT_SET_SELF_AS_DEBUGGER);
8168   UFWORDX("DEBUGGER-RESUME", MT_RESUME_DEBUGEE);
8169   UFWORDX("DEBUGGER-SINGLE-STEP", MT_SINGLE_STEP_DEBUGEE);
8170   UFWORDX("ACTIVE-STATE", MT_ACTIVE_STATE);
8171   UFWORDX("STATE-IP@", MT_STATE_IP_GET);
8172   UFWORDX("STATE-IP!", MT_STATE_IP_SET);
8173   UFWORDX("STATE-A>", MT_STATE_REGA_GET);
8174   UFWORDX("STATE->A", MT_STATE_REGA_SET);
8175   UFWORDX("STATE-USER@", MT_STATE_USER_GET);
8176   UFWORDX("STATE-USER!", MT_STATE_USER_SET);
8177   UFWORDX("STATE-RPOPCFA@", MT_STATE_RPOPCFA_GET);
8178   UFWORDX("STATE-RPOPCFA!", MT_STATE_RPOPCFA_SET);
8179   UFWORDX("YIELDED-FROM", MT_YIELDED_FROM);
8180   UFWORDX("STATE-SP@", MT_DSTACK_DEPTH_GET);
8181   UFWORDX("STATE-RP@", MT_RSTACK_DEPTH_GET);
8182   UFWORDX("STATE-LP@", MT_LP_GET);
8183   UFWORDX("STATE-LBP@", MT_LBP_GET);
8184   UFWORDX("STATE-SP!", MT_DSTACK_DEPTH_SET);
8185   UFWORDX("STATE-RP!", MT_RSTACK_DEPTH_SET);
8186   UFWORDX("STATE-LP!", MT_LP_SET);
8187   UFWORDX("STATE-LBP!", MT_LBP_SET);
8188   UFWORDX("STATE-DS@", MT_DSTACK_LOAD);
8189   UFWORDX("STATE-RS@", MT_RSTACK_LOAD);
8190   UFWORDX("STATE-LS@", MT_LSTACK_LOAD);
8191   UFWORDX("STATE-DS!", MT_DSTACK_STORE);
8192   UFWORDX("STATE-RS!", MT_RSTACK_STORE);
8193   UFWORDX("STATE-LS!", MT_LSTACK_STORE);
8194   ufoVocSetOnlyDefs(ufoForthVocId);
8195 }
8196
8197
8198 //==========================================================================
8199 //
8200 //  ufoInitTTYWords
8201 //
8202 //==========================================================================
8203 UFO_DISABLE_INLINE void ufoInitTTYWords (void) {
8204   // create "TTY" vocabulary
8205   const uint32_t ttyVocId = ufoCreateVoc("TTY", 0, UFW_FLAG_PROTECTED);
8206   ufoVocSetOnlyDefs(ttyVocId);
8207   UFWORDX("TTY?", TTY_TTYQ);
8208   UFWORDX("RAW?", TTY_RAWQ);
8209   UFWORDX("SIZE", TTY_SIZE);
8210   UFWORDX("SET-RAW", TTY_SET_RAW);
8211   UFWORDX("SET-COOKED", TTY_SET_COOKED);
8212   UFWORDX("RAW-EMIT", TTY_RAW_EMIT);
8213   UFWORDX("RAW-TYPE", TTY_RAW_TYPE);
8214   UFWORDX("RAW-FLUSH", TTY_RAW_FLUSH);
8215   UFWORDX("RAW-READCH", TTY_RAW_READCH);
8216   UFWORDX("RAW-READY?", TTY_RAW_READYQ);
8217   ufoVocSetOnlyDefs(ufoForthVocId);
8218 }
8219
8220
8221 //==========================================================================
8222 //
8223 //  ufoInitFilesWords
8224 //
8225 //==========================================================================
8226 UFO_DISABLE_INLINE void ufoInitFilesWords (void) {
8227   // create "FILES" vocabulary
8228   const uint32_t filesVocId = ufoCreateVoc("FILES", 0, UFW_FLAG_PROTECTED);
8229   ufoVocSetOnlyDefs(filesVocId);
8230   ufoDefineConstant("SEEK-SET", SEEK_SET);
8231   ufoDefineConstant("SEEK-CUR", SEEK_CUR);
8232   ufoDefineConstant("SEEK-END", SEEK_END);
8233
8234   UFWORDX("OPEN-R/O", FILES_OPEN_RO);
8235   UFWORDX("OPEN-R/W", FILES_OPEN_RW);
8236   UFWORDX("CREATE", FILES_CREATE);
8237   UFWORDX("CLOSE", FILES_CLOSE);
8238   UFWORDX("TELL", FILES_TELL);
8239   UFWORDX("SEEK-EX", FILES_SEEK_EX);
8240   UFWORDX("SIZE", FILES_SIZE);
8241   UFWORDX("READ", FILES_READ);
8242   UFWORDX("READ-EXACT", FILES_READ_EXACT);
8243   UFWORDX("WRITE", FILES_WRITE);
8244
8245   UFWORDX("UNLINK", FILES_UNLINK);
8246
8247   UFWORDX("ERRNO", FILES_ERRNO);
8248
8249   ufoInterpretLine(
8250     ": SEEK  ( ofs handle -- success? ) "
8251     "  SEEK-SET FORTH:SWAP SEEK-EX "
8252     ";");
8253
8254   /*
8255   ufoInterpretLine(
8256     ": READ-EXACT  ( addr count handle -- success? ) "
8257     "  FORTH:OVER FORTH:>R ( save count ) "
8258     "  READ FORTH:DUP FORTH:(0BRANCH) $files-read-exact-error "
8259     "  FORTH:DROP ( drop TRUE ) FORTH:R@ = "
8260     "$files-read-exact-error: "
8261     "  RDROP "
8262     ";");
8263   */
8264
8265   ufoVocSetOnlyDefs(ufoForthVocId);
8266 }
8267
8268
8269 //==========================================================================
8270 //
8271 //  ufoInitVeryVeryHighWords
8272 //
8273 //==========================================================================
8274 UFO_DISABLE_INLINE void ufoInitVeryVeryHighWords (void) {
8275   // interpret defer
8276   //ufoDefineDefer("INTERPRET", idumbCFA);
8277
8278   ufoDefineEmitType();
8279
8280   // ( addr count FALSE -- addr count FALSE / TRUE )
8281   ufoDefineSColonForth("(INTERPRET-CHECK-WORD)");
8282   ufoDoneForth();
8283   // ( addr count FALSE -- addr count FALSE / TRUE )
8284   ufoDefineSColonForth("(INTERPRET-WORD-NOT-FOUND)");
8285   ufoDoneForth();
8286   // ( -- ) -- called in "EXIT", before compiling "FORTH:(EXIT)"
8287   ufoDefineSColonForth("(EXIT-EXTENDER)");
8288   ufoDoneForth();
8289
8290   // EXIT  ( -- )
8291   ufoInterpretLine("!: EXIT  ( -- )  COMPILER:?COMP (EXIT-EXTENDER) COMPILE FORTH:(EXIT) ;");
8292
8293   ufoDefineInterpret();
8294
8295   //ufoDumpVocab(ufoCompilerVocId);
8296
8297   ufoInterpretLine(
8298     ": RUN-INTERPRET-LOOP "
8299     "$run-interp-loop-again: "
8300     "  RP0! INTERPRET (UFO-INTERPRET-FINISHED-ACTION) "
8301     "  FORTH:(BRANCH) $run-interp-loop-again "
8302     ";");
8303 }
8304
8305 #define UFO_ADD_DO_CFA(cfx_)  do { \
8306   ufoDo##cfx_##CFA = ufoCFAsUsed | UFO_ADDR_CFA_BIT; \
8307   ufoForthCFAs[ufoCFAsUsed] = &ufoDo##cfx_; \
8308   ufoCFAsUsed += 1; \
8309 } while (0)
8310
8311
8312 //==========================================================================
8313 //
8314 //  ufoInitCommon
8315 //
8316 //==========================================================================
8317 UFO_DISABLE_INLINE void ufoInitCommon (void) {
8318   ufoVSP = 0;
8319   ufoForthVocId = 0; ufoCompilerVocId = 0;
8320
8321   ufoForthCFAs = calloc(UFO_MAX_NATIVE_CFAS, sizeof(ufoForthCFAs[0]));
8322
8323   // allocate default TIB handle
8324   //UfoHandle *tibh = ufoAllocHandle(0x69a029a6); // arbitrary number
8325   //ufoDefTIB = tibh->ufoHandle;
8326
8327   ufoForthCFAs[0] = NULL; ufoCFAsUsed = 1u;
8328   UFO_ADD_DO_CFA(Forth);
8329   UFO_ADD_DO_CFA(Variable);
8330   UFO_ADD_DO_CFA(Value);
8331   UFO_ADD_DO_CFA(Const);
8332   UFO_ADD_DO_CFA(Defer);
8333   UFO_ADD_DO_CFA(Voc);
8334   UFO_ADD_DO_CFA(Create);
8335   UFO_ADD_DO_CFA(UserVariable);
8336
8337   //fprintf(stderr, "DO-FORTH-CFA: 0x%08x\n", ufoDoForthCFA);
8338
8339   ufoInitBaseDict();
8340
8341   // create "FORTH" vocabulary (it should be the first one)
8342   ufoForthVocId = ufoCreateVoc("FORTH", 0, UFW_FLAG_PROTECTED);
8343   ufoVocSetOnlyDefs(ufoForthVocId);
8344
8345   // base low-level interpreter words
8346   ufoInitBasicWords();
8347
8348   // more FORTH words
8349   ufoInitMoreWords();
8350
8351   // some COMPILER words
8352   ufoInitBasicCompilerWords();
8353
8354   // STRING vocabulary
8355   ufoInitStringWords();
8356
8357   // DEBUG vocabulary
8358   ufoInitDebugWords();
8359
8360   // MTASK vocabulary
8361   ufoInitMTWords();
8362
8363   // HANDLE vocabulary
8364   ufoInitHandleWords();
8365
8366   // TTY vocabulary
8367   ufoInitTTYWords();
8368
8369   // FILES vocabulary
8370   ufoInitFilesWords();
8371
8372   // some higher-level FORTH words (includes, etc.)
8373   ufoInitHigherWords();
8374
8375   // very-very high-level FORTH words
8376   ufoInitVeryVeryHighWords();
8377
8378   ufoFinalLabelCheck();
8379
8380   #if 0
8381   ufoDecompileWord(ufoFindWordChecked("RUN-INTERPRET-LOOP"));
8382   #endif
8383
8384   ufoReset();
8385 }
8386
8387 #undef UFC
8388
8389
8390 // ////////////////////////////////////////////////////////////////////////// //
8391 // virtual machine executor
8392 //
8393
8394
8395 //==========================================================================
8396 //
8397 //  ufoRunVM
8398 //
8399 //  address interpreter
8400 //
8401 //==========================================================================
8402 static void ufoRunVMCFA (uint32_t cfa) {
8403   const uint32_t oldRPTop = ufoRPTop;
8404   ufoRPTop = ufoRP;
8405   #ifdef UFO_TRACE_VM_RUN
8406   fprintf(stderr, "**VM-INITIAL**: cfa=%u\n", cfa);
8407   UFCALL(DUMP_STACK);
8408   #endif
8409   ufoRPush(cfa);
8410   ufoVMRPopCFA = 1;
8411   ufoVMStop = 0;
8412   // VM execution loop
8413   do {
8414     if (ufoVMAbort) ufoFatal("user abort");
8415     if (ufoVMStop) { ufoRP = oldRPTop; break; }
8416     if (ufoCurrState == NULL) ufoFatal("execution state is lost");
8417     if (ufoVMRPopCFA == 0) {
8418       // check IP
8419       if (ufoIP == 0) ufoFatal("IP is NULL");
8420       if (ufoIP & UFO_ADDR_HANDLE_BIT) ufoFatal("IP is a handle");
8421       cfa = ufoImgGetU32(ufoIP); ufoIP += 4u;
8422     } else {
8423       cfa = ufoRPop(); ufoVMRPopCFA = 0;
8424     }
8425     // check CFA sanity
8426     if (cfa == 0) ufoFatal("EXECUTE: NULL CFA");
8427     if (cfa & UFO_ADDR_HANDLE_BIT) ufoFatal("cannot execute handle");
8428     // get next word CFAIDX, and check it
8429     uint32_t cfaidx = ufoImgGetU32(cfa);
8430     if (cfaidx & UFO_ADDR_HANDLE_BIT) ufoFatal("cannot execute CFAIDX-handle");
8431     #ifdef UFO_TRACE_VM_RUN
8432     fprintf(stderr, "**VM**: IP=%u; cfa=%u; cfaidx=0x%08x\n", ufoIP - 4u, cfa, cfaidx);
8433     UFCALL(DUMP_STACK);
8434     ufoDumpWordHeader(UFO_CFA_TO_LFA(cfa));
8435     fprintf(stderr, "######################################\n");
8436     #endif
8437     if (cfaidx & UFO_ADDR_CFA_BIT) {
8438       cfaidx &= UFO_ADDR_CFA_MASK;
8439       if (cfaidx >= ufoCFAsUsed || ufoForthCFAs[cfaidx] == NULL) {
8440         ufoFatal("tried to execute an unknown word: %u (max is %u); IP=%u",
8441                  cfaidx, ufoCFAsUsed, ufoIP - 4u);
8442       }
8443       #ifdef UFO_TRACE_VM_RUN
8444       fprintf(stderr, "**VM-NATIVE**: cfaidx=%u (doForth=%u)\n", cfaidx,
8445               (ufoDoForthCFA & UFO_ADDR_CFA_MASK));
8446       #endif
8447       ufoForthCFAs[cfaidx](UFO_CFA_TO_PFA(cfa));
8448     } else {
8449       // if CFA points somewhere inside a dict, this is "DOES>" word
8450       // IP points to PFA we need to push
8451       // CFA points to Forth word we need to jump to
8452       #ifdef UFO_TRACE_VM_DOER
8453       fprintf(stderr, "*** DOER! IP=%u; cfa=%u; cfaidx=%u ***\n", ufoIP, cfa, cfaidx);
8454       UFCALL(UFO_BACKTRACE);
8455       #endif
8456       ufoPush(UFO_CFA_TO_PFA(cfa)); // push PFA
8457       ufoRPush(ufoIP); // push IP
8458       ufoIP = cfaidx; // fix IP
8459     }
8460     // that's all we need to activate the debugger
8461     if (ufoSingleStep) {
8462       ufoSingleStep -= 1;
8463       if (ufoSingleStep == 0 && ufoDebuggerState != NULL) {
8464         if (ufoCurrState == ufoDebuggerState) ufoFatal("debugger cannot debug itself");
8465         UfoState *ost = ufoCurrState;
8466         ufoSwitchToState(ufoDebuggerState); // always use API call for this!
8467         ufoPush(-2);
8468         ufoPush(ost->id);
8469       }
8470     }
8471   } while (ufoRP != oldRPTop);
8472   //ufoVMStop = 0;
8473 }
8474
8475
8476 // ////////////////////////////////////////////////////////////////////////// //
8477 // high-level API
8478 //
8479
8480 //==========================================================================
8481 //
8482 //  ufoRegisterWord
8483 //
8484 //  register new word
8485 //
8486 //==========================================================================
8487 uint32_t ufoRegisterWord (const char *wname, ufoNativeCFA cfa, uint32_t flags) {
8488   ufo_assert(cfa != NULL);
8489   ufo_assert(wname != NULL && wname[0] != 0);
8490   uint32_t cfaidx = ufoCFAsUsed;
8491   if (cfaidx >= UFO_MAX_NATIVE_CFAS) ufoFatal("too many native words");
8492   ufoForthCFAs[cfaidx] = cfa;
8493   ufoCFAsUsed += 1;
8494   //ufoDefineNative(wname, xcfa, 0);
8495   cfaidx |= UFO_ADDR_CFA_BIT;
8496   flags &= 0xffffff00u;
8497   ufoCreateWordHeader(wname, flags);
8498   const uint32_t res = UFO_GET_DP();
8499   ufoImgEmitU32(cfaidx);
8500   return res;
8501 }
8502
8503
8504 //==========================================================================
8505 //
8506 //  ufoRegisterDataWord
8507 //
8508 //==========================================================================
8509 static uint32_t ufoRegisterDataWord (const char *wname, uint32_t cfaidx, uint32_t value,
8510                                      uint32_t flags)
8511 {
8512   ufo_assert(wname != NULL && wname[0] != 0);
8513   flags &= 0xffffff00u;
8514   ufoCreateWordHeader(wname, flags);
8515   ufoImgEmitU32(cfaidx);
8516   const uint32_t res = UFO_GET_DP();
8517   ufoImgEmitU32(value);
8518   return res;
8519 }
8520
8521
8522 //==========================================================================
8523 //
8524 //  ufoRegisterConstant
8525 //
8526 //==========================================================================
8527 void ufoRegisterConstant (const char *wname, uint32_t value, uint32_t flags) {
8528   (void)ufoRegisterDataWord(wname, ufoDoConstCFA, value, flags);
8529 }
8530
8531
8532 //==========================================================================
8533 //
8534 //  ufoRegisterVariable
8535 //
8536 //==========================================================================
8537 uint32_t ufoRegisterVariable (const char *wname, uint32_t value, uint32_t flags) {
8538   return ufoRegisterDataWord(wname, ufoDoVariableCFA, value, flags);
8539 }
8540
8541
8542 //==========================================================================
8543 //
8544 //  ufoRegisterValue
8545 //
8546 //==========================================================================
8547 uint32_t ufoRegisterValue (const char *wname, uint32_t value, uint32_t flags) {
8548   return ufoRegisterDataWord(wname, ufoDoValueCFA, value, flags);
8549 }
8550
8551
8552 //==========================================================================
8553 //
8554 //  ufoRegisterDefer
8555 //
8556 //==========================================================================
8557 uint32_t ufoRegisterDefer (const char *wname, uint32_t value, uint32_t flags) {
8558   return ufoRegisterDataWord(wname, ufoDoDeferCFA, value, flags);
8559 }
8560
8561
8562 //==========================================================================
8563 //
8564 //  ufoFindWordInVocabulary
8565 //
8566 //  check if we have the corresponding word.
8567 //  return CFA suitable for executing, or 0.
8568 //
8569 //==========================================================================
8570 uint32_t ufoFindWordInVocabulary (const char *wname, uint32_t vocid) {
8571   if (wname == NULL || wname[0] == 0) return 0;
8572   size_t wlen = strlen(wname);
8573   if (wlen >= UFO_MAX_WORD_LENGTH) return 0;
8574   return ufoFindWordInVocAndParents(wname, (uint32_t)wlen, 0, vocid, 0);
8575 }
8576
8577
8578 //==========================================================================
8579 //
8580 //  ufoGetIP
8581 //
8582 //==========================================================================
8583 uint32_t ufoGetIP (void) {
8584   return ufoIP;
8585 }
8586
8587
8588 //==========================================================================
8589 //
8590 //  ufoSetIP
8591 //
8592 //==========================================================================
8593 void ufoSetIP (uint32_t newip) {
8594   ufoIP = newip;
8595 }
8596
8597
8598 //==========================================================================
8599 //
8600 //  ufoIsExecuting
8601 //
8602 //==========================================================================
8603 int ufoIsExecuting (void) {
8604   return (ufoImgGetU32(ufoAddrSTATE) == 0);
8605 }
8606
8607
8608 //==========================================================================
8609 //
8610 //  ufoIsCompiling
8611 //
8612 //==========================================================================
8613 int ufoIsCompiling (void) {
8614   return (ufoImgGetU32(ufoAddrSTATE) != 0);
8615 }
8616
8617
8618 //==========================================================================
8619 //
8620 //  ufoSetExecuting
8621 //
8622 //==========================================================================
8623 void ufoSetExecuting (void) {
8624   ufoImgPutU32(ufoAddrSTATE, 0);
8625 }
8626
8627
8628 //==========================================================================
8629 //
8630 //  ufoSetCompiling
8631 //
8632 //==========================================================================
8633 void ufoSetCompiling (void) {
8634   ufoImgPutU32(ufoAddrSTATE, 1);
8635 }
8636
8637
8638 //==========================================================================
8639 //
8640 //  ufoGetHere
8641 //
8642 //==========================================================================
8643 uint32_t ufoGetHere () {
8644   return UFO_GET_DP();
8645 }
8646
8647
8648 //==========================================================================
8649 //
8650 //  ufoGetPad
8651 //
8652 //==========================================================================
8653 uint32_t ufoGetPad () {
8654   UFCALL(PAD);
8655   return ufoPop();
8656 }
8657
8658
8659 //==========================================================================
8660 //
8661 //  ufoTIBPeekCh
8662 //
8663 //==========================================================================
8664 uint8_t ufoTIBPeekCh (uint32_t ofs) {
8665   return ufoTibPeekChOfs(ofs);
8666 }
8667
8668
8669 //==========================================================================
8670 //
8671 //  ufoTIBGetCh
8672 //
8673 //==========================================================================
8674 uint8_t ufoTIBGetCh (void) {
8675   return ufoTibGetCh();
8676 }
8677
8678
8679 //==========================================================================
8680 //
8681 //  ufoTIBSkipCh
8682 //
8683 //==========================================================================
8684 void ufoTIBSkipCh (void) {
8685   ufoTibSkipCh();
8686 }
8687
8688
8689 //==========================================================================
8690 //
8691 //  ufoTIBSRefill
8692 //
8693 //  returns 0 on EOF
8694 //
8695 //==========================================================================
8696 int ufoTIBSRefill (int allowCrossIncludes) {
8697   return ufoLoadNextLine(allowCrossIncludes);
8698 }
8699
8700
8701 //==========================================================================
8702 //
8703 //  ufoPeekData
8704 //
8705 //==========================================================================
8706 uint32_t ufoPeekData (void) {
8707   return ufoPeek();
8708 }
8709
8710
8711 //==========================================================================
8712 //
8713 //  ufoPopData
8714 //
8715 //==========================================================================
8716 uint32_t ufoPopData (void) {
8717   return ufoPop();
8718 }
8719
8720
8721 //==========================================================================
8722 //
8723 //  ufoPushData
8724 //
8725 //==========================================================================
8726 void ufoPushData (uint32_t value) {
8727   return ufoPush(value);
8728 }
8729
8730
8731 //==========================================================================
8732 //
8733 //  ufoPushBoolData
8734 //
8735 //==========================================================================
8736 void ufoPushBoolData (int val) {
8737   ufoPushBool(val);
8738 }
8739
8740
8741 //==========================================================================
8742 //
8743 //  ufoPeekRet
8744 //
8745 //==========================================================================
8746 uint32_t ufoPeekRet (void) {
8747   return ufoRPeek();
8748 }
8749
8750
8751 //==========================================================================
8752 //
8753 //  ufoPopRet
8754 //
8755 //==========================================================================
8756 uint32_t ufoPopRet (void) {
8757   return ufoRPop();
8758 }
8759
8760
8761 //==========================================================================
8762 //
8763 //  ufoPushRet
8764 //
8765 //==========================================================================
8766 void ufoPushRet (uint32_t value) {
8767   return ufoRPush(value);
8768 }
8769
8770
8771 //==========================================================================
8772 //
8773 //  ufoPushBoolRet
8774 //
8775 //==========================================================================
8776 void ufoPushBoolRet (int val) {
8777   ufoRPush(val ? ufoTrueValue : 0);
8778 }
8779
8780
8781 //==========================================================================
8782 //
8783 //  ufoPeekByte
8784 //
8785 //==========================================================================
8786 uint8_t ufoPeekByte (uint32_t addr) {
8787   return ufoImgGetU8Ext(addr);
8788 }
8789
8790
8791 //==========================================================================
8792 //
8793 //  ufoPeekWord
8794 //
8795 //==========================================================================
8796 uint16_t ufoPeekWord (uint32_t addr) {
8797   ufoPush(addr);
8798   UFCALL(WPEEK);
8799   return ufoPop();
8800 }
8801
8802
8803 //==========================================================================
8804 //
8805 //  ufoPeekCell
8806 //
8807 //==========================================================================
8808 uint32_t ufoPeekCell (uint32_t addr) {
8809   ufoPush(addr);
8810   UFCALL(PEEK);
8811   return ufoPop();
8812 }
8813
8814
8815 //==========================================================================
8816 //
8817 //  ufoPokeByte
8818 //
8819 //==========================================================================
8820 void ufoPokeByte (uint32_t addr, uint32_t value) {
8821   ufoImgPutU8(addr, value);
8822 }
8823
8824
8825 //==========================================================================
8826 //
8827 //  ufoPokeWord
8828 //
8829 //==========================================================================
8830 void ufoPokeWord (uint32_t addr, uint32_t value) {
8831   ufoPush(value);
8832   ufoPush(addr);
8833   UFCALL(WPOKE);
8834 }
8835
8836
8837 //==========================================================================
8838 //
8839 //  ufoPokeCell
8840 //
8841 //==========================================================================
8842 void ufoPokeCell (uint32_t addr, uint32_t value) {
8843   ufoPush(value);
8844   ufoPush(addr);
8845   UFCALL(POKE);
8846 }
8847
8848
8849 //==========================================================================
8850 //
8851 //  ufoGetPAD
8852 //
8853 //==========================================================================
8854 uint32_t ufoGetPAD (void) {
8855   return UFO_PAD_ADDR;
8856 }
8857
8858
8859 //==========================================================================
8860 //
8861 //  ufoEmitByte
8862 //
8863 //==========================================================================
8864 void ufoEmitByte (uint32_t value) {
8865   ufoImgEmitU8(value);
8866 }
8867
8868
8869 //==========================================================================
8870 //
8871 //  ufoEmitWord
8872 //
8873 //==========================================================================
8874 void ufoEmitWord (uint32_t value) {
8875   ufoImgEmitU8(value & 0xff);
8876   ufoImgEmitU8((value >> 8) & 0xff);
8877 }
8878
8879
8880 //==========================================================================
8881 //
8882 //  ufoEmitCell
8883 //
8884 //==========================================================================
8885 void ufoEmitCell (uint32_t value) {
8886   ufoImgEmitU32(value);
8887 }
8888
8889
8890 //==========================================================================
8891 //
8892 //  ufoIsInited
8893 //
8894 //==========================================================================
8895 int ufoIsInited (void) {
8896   return (ufoMode != UFO_MODE_NONE);
8897 }
8898
8899
8900 static void (*ufoUserPostInitCB) (void);
8901
8902
8903 //==========================================================================
8904 //
8905 //  ufoSetUserPostInit
8906 //
8907 //  called after main initialisation
8908 //
8909 //==========================================================================
8910 void ufoSetUserPostInit (void (*cb) (void)) {
8911   ufoUserPostInitCB = cb;
8912 }
8913
8914
8915 //==========================================================================
8916 //
8917 //  ufoInit
8918 //
8919 //==========================================================================
8920 void ufoInit (void) {
8921   if (ufoMode != UFO_MODE_NONE) return;
8922   ufoMode = UFO_MODE_NATIVE;
8923
8924   ufoInFileLine = 0;
8925   ufoInFileName = NULL; ufoInFileNameLen = 0; ufoInFileNameHash = 0;
8926   ufoInFile = NULL;
8927   ufoLastIncPath = NULL; ufoLastSysIncPath = NULL;
8928
8929   for (uint32_t f = 0; f < UFO_MAX_STATES; f += 1u) ufoStateMap[f] = NULL;
8930   memset(ufoStateUsedBitmap, 0, sizeof(ufoStateUsedBitmap));
8931
8932   ufoCurrState = ufoNewState();
8933   strcpy(ufoCurrState->name, "MAIN");
8934   ufoInitStateUserVars(ufoCurrState, 0);
8935   ufoImgPutU32(ufoAddrDefTIB, 0); // create TIB handle
8936   ufoImgPutU32(ufoAddrTIBx, 0); // create TIB handle
8937
8938   ufoYieldedState = NULL;
8939   ufoDebuggerState = NULL;
8940   ufoSingleStep = 0;
8941
8942   #ifdef UFO_DEBUG_STARTUP_TIMES
8943   uint32_t stt = ufo_get_msecs();
8944   ufoCondDefine("UFO-DEBUG-STARTUP-TIMES");
8945   #endif
8946   ufoInitCommon();
8947   #ifdef UFO_DEBUG_STARTUP_TIMES
8948   uint32_t ett = ufo_get_msecs();
8949   fprintf(stderr, "UrForth init time: %u msecs\n", (unsigned)(ett - stt));
8950   #endif
8951
8952   ufoReset();
8953
8954   if (ufoUserPostInitCB) {
8955     ufoUserPostInitCB();
8956     ufoReset();
8957   }
8958
8959   // load ufo modules
8960   char *ufmname = ufoCreateIncludeName("init", 1, NULL);
8961   #ifdef WIN32
8962   FILE *ufl = fopen(ufmname, "rb");
8963   #else
8964   FILE *ufl = fopen(ufmname, "r");
8965   #endif
8966   if (ufl) {
8967     ufoPushInFile();
8968     ufoSetInFileNameReuse(ufmname);
8969     ufoInFile = ufl;
8970     ufoFileId = ufoLastUsedFileId;
8971     setLastIncPath(ufoInFileName, 1);
8972   } else {
8973     free(ufmname);
8974     ufoFatal("cannot load init code");
8975   }
8976
8977   if (ufoInFile != NULL) {
8978     ufoRunInterpretLoop();
8979   }
8980 }
8981
8982
8983 //==========================================================================
8984 //
8985 //  ufoFinishVM
8986 //
8987 //==========================================================================
8988 void ufoFinishVM (void) {
8989   ufoVMStop = 1;
8990 }
8991
8992
8993 //==========================================================================
8994 //
8995 //  ufoWasVMFinished
8996 //
8997 //  check if VM was exited due to `ufoFinishVM()`
8998 //
8999 //==========================================================================
9000 int ufoWasVMFinished (void) {
9001   return (ufoVMStop != 0);
9002 }
9003
9004
9005 //==========================================================================
9006 //
9007 //  ufoCallParseIntr
9008 //
9009 //  ( -- addr count TRUE / FALSE )
9010 //  does base TIB parsing; never copies anything.
9011 //  as our reader is line-based, returns FALSE on EOL.
9012 //  EOL is detected after skipping leading delimiters.
9013 //  passing -1 as delimiter skips the whole line, and always returns FALSE.
9014 //  trailing delimiter is always skipped.
9015 //  result is on the data stack.
9016 //
9017 //==========================================================================
9018 void ufoCallParseIntr (uint32_t delim, int skipLeading) {
9019   ufoPush(delim); ufoPushBool(skipLeading);
9020   UFCALL(PAR_PARSE);
9021 }
9022
9023 //==========================================================================
9024 //
9025 //  ufoCallParseName
9026 //
9027 //  ( -- addr count )
9028 //  parse with leading blanks skipping. doesn't copy anything.
9029 //  return empty string on EOL.
9030 //
9031 //==========================================================================
9032 void ufoCallParseName (void) {
9033   UFCALL(PARSE_NAME);
9034 }
9035
9036
9037 //==========================================================================
9038 //
9039 //  ufoCallParse
9040 //
9041 //  ( -- addr count TRUE / FALSE )
9042 //  parse without skipping delimiters; never copies anything.
9043 //  as our reader is line-based, returns FALSE on EOL.
9044 //  passing 0 as delimiter skips the whole line, and always returns FALSE.
9045 //  trailing delimiter is always skipped.
9046 //
9047 //==========================================================================
9048 void ufoCallParse (uint32_t delim) {
9049   ufoPush(delim);
9050   UFCALL(PARSE);
9051 }
9052
9053
9054 //==========================================================================
9055 //
9056 //  ufoCallParseSkipBlanks
9057 //
9058 //==========================================================================
9059 void ufoCallParseSkipBlanks (void) {
9060   UFCALL(PARSE_SKIP_BLANKS);
9061 }
9062
9063
9064 //==========================================================================
9065 //
9066 //  ufoCallParseSkipComments
9067 //
9068 //==========================================================================
9069 void ufoCallParseSkipComments (void) {
9070   ufoPushBool(1); UFCALL(PAR_PARSE_SKIP_COMMENTS);
9071 }
9072
9073
9074 //==========================================================================
9075 //
9076 //  ufoCallParseSkipLineComments
9077 //
9078 //==========================================================================
9079 void ufoCallParseSkipLineComments (void) {
9080   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
9081 }
9082
9083
9084 //==========================================================================
9085 //
9086 //  ufoCallParseSkipLine
9087 //
9088 //  to the end of line; doesn't refill
9089 //
9090 //==========================================================================
9091 void ufoCallParseSkipLine (void) {
9092   UFCALL(PARSE_SKIP_LINE);
9093 }
9094
9095
9096 //==========================================================================
9097 //
9098 //  ufoCallBasedNumber
9099 //
9100 //  convert number from addrl+1
9101 //  returns address of the first inconvertible char
9102 //  (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
9103 //
9104 //==========================================================================
9105 void ufoCallBasedNumber (uint32_t addr, uint32_t count, int allowSign, int base) {
9106   ufoPush(addr); ufoPush(count); ufoPushBool(allowSign);
9107   if (base < 0) ufoPush(0); else ufoPush((uint32_t)base);
9108   UFCALL(PAR_BASED_NUMBER);
9109 }
9110
9111
9112 //==========================================================================
9113 //
9114 //  ufoRunWord
9115 //
9116 //==========================================================================
9117 void ufoRunWord (uint32_t cfa) {
9118   if (cfa != 0) {
9119     if (ufoMode == UFO_MODE_NONE) ufoFatal("UrForth is not properly inited");
9120     if (ufoInRunWord) ufoFatal("`ufoRunWord` cannot be called recursively");
9121     ufoMode = UFO_MODE_NATIVE;
9122     ufoInRunWord = 1;
9123     ufoRunVMCFA(cfa);
9124     ufoInRunWord = 0;
9125   }
9126 }
9127
9128
9129 //==========================================================================
9130 //
9131 //  ufoRunMacroWord
9132 //
9133 //==========================================================================
9134 void ufoRunMacroWord (uint32_t cfa) {
9135   if (cfa != 0) {
9136     if (ufoMode == UFO_MODE_NONE) ufoFatal("UrForth is not properly inited");
9137     if (ufoInRunWord) ufoFatal("`ufoRunWord` cannot be called recursively");
9138     ufoMode = UFO_MODE_MACRO;
9139     const uint32_t oisp = ufoFileStackPos;
9140     ufoPushInFile();
9141     ufoFileId = 0;
9142     (void)ufoLoadNextUserLine();
9143     ufoInRunWord = 1;
9144     ufoRunVMCFA(cfa);
9145     ufoInRunWord = 0;
9146     ufoPopInFile();
9147     ufo_assert(ufoFileStackPos == oisp); // sanity check
9148   }
9149 }
9150
9151
9152 //==========================================================================
9153 //
9154 //  ufoIsInMacroMode
9155 //
9156 //  check if we are currently in "MACRO" mode.
9157 //  should be called from registered words.
9158 //
9159 //==========================================================================
9160 int ufoIsInMacroMode (void) {
9161   return (ufoMode == UFO_MODE_MACRO);
9162 }
9163
9164
9165 //==========================================================================
9166 //
9167 //  ufoRunInterpretLoop
9168 //
9169 //  run default interpret loop.
9170 //
9171 //==========================================================================
9172 void ufoRunInterpretLoop (void) {
9173   if (ufoMode == UFO_MODE_NONE) {
9174     ufoInit();
9175   }
9176   const uint32_t cfa = ufoFindWord("RUN-INTERPRET-LOOP");
9177   if (cfa == 0) ufoFatal("'RUN-INTERPRET-LOOP' word not found");
9178   ufoReset();
9179   ufoMode = UFO_MODE_NATIVE;
9180   ufoInRunWord = 1;
9181   ufoRunVMCFA(cfa);
9182   ufoInRunWord = 0;
9183   while (ufoFileStackPos != 0) ufoPopInFile();
9184 }
9185
9186
9187 //==========================================================================
9188 //
9189 //  ufoRunFile
9190 //
9191 //==========================================================================
9192 void ufoRunFile (const char *fname) {
9193   if (ufoMode == UFO_MODE_NONE) {
9194     ufoInit();
9195   }
9196   if (ufoInRunWord) ufoFatal("`ufoRunFile` cannot be called recursively");
9197   ufoMode = UFO_MODE_NATIVE;
9198
9199   ufoReset();
9200   char *ufmname = ufoCreateIncludeName(fname, 0, ".");
9201   #ifdef WIN32
9202   FILE *ufl = fopen(ufmname, "rb");
9203   #else
9204   FILE *ufl = fopen(ufmname, "r");
9205   #endif
9206   if (ufl) {
9207     ufoPushInFile();
9208     ufoSetInFileNameReuse(ufmname);
9209     ufoInFile = ufl;
9210     ufoFileId = ufoLastUsedFileId;
9211     setLastIncPath(ufoInFileName, 0);
9212   } else {
9213     free(ufmname);
9214     ufoFatal("cannot load source file '%s'", fname);
9215   }
9216   ufoRunInterpretLoop();
9217 }