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 // if defined, UFO will allocate 64MB main image, and 4MB temp image immediately
  26 #define UFO_HUGE_IMAGES
  27
  28 // use relative branch addresses for position-independent code?
  29 #define UFO_RELATIVE_BRANCH
  30
  31 // if defined, multitasking engine is allowed.
  32 // multitasker is currently used only for debugger.
  33 //#define UFO_MTASK_ALLOWED
  34
  35
  36 //#define UFO_DEBUG_WRITE_MAIN_IMAGE
  37 //#define UFO_DEBUG_WRITE_DEBUG_IMAGE
  38
  39
  40 #define UFO_DEBUG_STARTUP_TIMES
  41 //#define UFO_DEBUG_FATAL_ABORT
  42 #define UFO_DEBUG_DEBUG  /* ;-) */
  43 //#define UFO_TRACE_VM_DOER
  44 //#define UFO_TRACE_VM_RUN
  45 //#define UFO_DEBUG_INCLUDE
  46 //#define UFO_DEBUG_DUMP_NEW_HEADERS
  47 //#define UFO_DEBUG_FIND_WORD
  48 //#define UFO_DEBUG_FIND_WORD_IN_VOC
  49 //#define UFO_DEBUG_FIND_WORD_COLON
  50
  51 // 2/8 msecs w/o inlining
  52 // 1/5 msecs with inlining
  53 #if 1
  54 # define UFO_FORCE_INLINE static inline __attribute__((always_inline))
  55 #else
  56 # define UFO_FORCE_INLINE static __attribute__((noinline)) /*__attribute__((unused))*/
  57 #endif
  58 #define UFO_DISABLE_INLINE static __attribute__((noinline)) /*__attribute__((unused))*/
  59
  60 // detect arch, and use faster memory access code on x86
  61 #if defined(__x86_64__) || defined(_M_X64) || \
  62     defined(i386) || defined(__i386__) || defined(__i386) || defined(_M_IX86)
  63 # define UFO_FAST_MEM_ACCESS
  64 #endif
  65
  66 // should not be bigger than this!
  67 #define UFO_MAX_WORD_LENGTH  (250)
  68
  69 //#define UFO_ALIGN4(v_)  (((v_) + 3u) / 4u * 4u)
  70 #define UFO_ALIGN4(v_)  (((v_) + 3u) & ~(uint32_t)3)
  71
  72
  73 // ////////////////////////////////////////////////////////////////////////// //
  74 static void ufoFlushOutput (void);
  75
  76 UFO_DISABLE_INLINE const char *ufo_assert_failure (const char *cond, const char *fname,
  77                                                    int fline, const char *func)
  78 {
  79   for (const char *t = fname; *t; ++t) {
  80     #ifdef WIN32
  81     if (*t == '/' || *t == '\\') fname = t+1;
  82     #else
  83     if (*t == '/') fname = t+1;
  84     #endif
  85   }
  86   ufoFlushOutput();
  87   fprintf(stderr, "\n%s:%d: Assertion in `%s` failed: %s\n", fname, fline, func, cond);
  88   ufoFlushOutput();
  89   abort();
  90 }
  91
  92 #define ufo_assert(cond_)  do { if (__builtin_expect((!(cond_)), 0)) { ufo_assert_failure(#cond_, __FILE__, __LINE__, __PRETTY_FUNCTION__); } } while (0)
  93
  94
  95 static char ufoRealPathBuf[32769];
  96 static char ufoRealPathHashBuf[32769];
  97
  98
  99 //==========================================================================
 100 //
 101 //  ufoRealPath
 102 //
 103 //==========================================================================
 104 static char *ufoRealPath (const char *fname) {
 105   char *res;
 106   if (fname != NULL && fname[0] != 0) {
 107     res = realpath(fname, NULL);
 108     if (res != NULL) {
 109       const size_t slen = strlen(res);
 110       if (slen < 32768) {
 111         strcpy(ufoRealPathBuf, res);
 112         free(res);
 113         res = ufoRealPathBuf;
 114       } else {
 115         free(res);
 116         res = NULL;
 117       }
 118     }
 119   } else {
 120     res = NULL;
 121   }
 122   return res;
 123 }
 124
 125
 126 #ifndef WIN32
 127 static time_t secstart = 0;
 128 #endif
 129
 130
 131
 132 //==========================================================================
 133 //
 134 //  ufo_get_msecs
 135 //
 136 //==========================================================================
 137 static uint64_t ufo_get_msecs (void) {
 138   #ifdef WIN32
 139   return GetTickCount();
 140   #else
 141   struct timespec ts;
 142   #ifdef CLOCK_MONOTONIC
 143   ufo_assert(clock_gettime(CLOCK_MONOTONIC, &ts) == 0);
 144   #else
 145   // this should be available everywhere
 146   ufo_assert(clock_gettime(CLOCK_REALTIME, &ts) == 0);
 147   #endif
 148   // first run?
 149   if (secstart == 0) {
 150     secstart = ts.tv_sec+1;
 151     ufo_assert(secstart); // it should not be zero
 152   }
 153   return (uint64_t)(ts.tv_sec-secstart+2)*1000U+(uint32_t)ts.tv_nsec/1000000U;
 154   // nanoseconds
 155   //return (uint64_t)(ts.tv_sec-secstart+2)*1000000000U+(uint32_t)ts.tv_nsec;
 156   #endif
 157 }
 158
 159
 160 //==========================================================================
 161 //
 162 //  joaatHashBuf
 163 //
 164 //==========================================================================
 165 UFO_FORCE_INLINE uint32_t joaatHashBuf (const void *buf, size_t len, uint8_t orbyte) {
 166   uint32_t hash = 0x29a;
 167   const uint8_t *s = (const uint8_t *)buf;
 168   while (len--) {
 169     hash += (*s++)|orbyte;
 170     hash += hash<<10;
 171     hash ^= hash>>6;
 172   }
 173   // finalize
 174   hash += hash<<3;
 175   hash ^= hash>>11;
 176   hash += hash<<15;
 177   return hash;
 178 }
 179
 180
 181 // this converts ASCII capitals to locase (and destroys other, but who cares)
 182 #define joaatHashBufCI(buf_,len_)  joaatHashBuf((buf_), (len_), 0x20)
 183
 184
 185 //==========================================================================
 186 //
 187 //  toUpper
 188 //
 189 //==========================================================================
 190 UFO_FORCE_INLINE char toUpper (char ch) {
 191   return (ch >= 'a' && ch <= 'z' ? ch-'a'+'A' : ch);
 192 }
 193
 194
 195 //==========================================================================
 196 //
 197 //  toUpperU8
 198 //
 199 //==========================================================================
 200 UFO_FORCE_INLINE uint8_t toUpperU8 (uint8_t ch) {
 201   return (ch >= 'a' && ch <= 'z' ? ch-'a'+'A' : ch);
 202 }
 203
 204
 205 //==========================================================================
 206 //
 207 //  digitInBase
 208 //
 209 //==========================================================================
 210 UFO_FORCE_INLINE int digitInBase (char ch, int base) {
 211   switch (ch) {
 212     case '0' ... '9': ch = ch - '0'; break;
 213     case 'A' ... 'Z': ch = ch - 'A' + 10; break;
 214     case 'a' ... 'z': ch = ch - 'a' + 10; break;
 215     default: base = -1; break;
 216   }
 217   return (ch >= 0 && ch < base ? ch : -1);
 218 }
 219
 220
 221 /*
 222 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 223 ;; word header format:
 224 ;; note than name hash is ALWAYS calculated with ASCII-uppercased name
 225 ;; (actually, bit 5 is always reset for all bytes, because we don't need the
 226 ;; exact uppercase, only something that resembles it)
 227 ;; bfa points to next bfa or to 0 (this is "hash bucket pointer")
 228 ;; before nfa, we have such "hidden" fields:
 229 ;;   dd xfa       ; points to the previous word header XFA, regardless of vocabularies (or 0)
 230 ;;   dd yfa       ; points to the next word header YFA, regardless of vocabularies (or 0)
 231 ;;   dd bfa       ; next word in hashtable bucket; it is always here, even if hashtable is turned off
 232 ;;                ; if there is no hashtable, this field is not used
 233 ;; lfa:
 234 ;;   dd lfa       ; previous vocabulary word LFA or 0 (lfa links points here)
 235 ;;   dd namehash  ; it is always here, and always calculated, even if hashtable is turned off
 236 ;; nfa:
 237 ;;   dd flags-and-name-len   ; see below
 238 ;;   db name      ; no terminating zero or other "termination flag" here
 239 ;;  here could be some 0 bytes to align everything to 4 bytes
 240 ;;   db namelen   ; yes, name length again, so CFA->NFA can avoid guessing
 241 ;;                ; full length, including padding, but not including this byte
 242 ;; cfa:
 243 ;;   dd cfaidx    ; our internal CFA index, or image address for DOES>
 244 ;;   dd ?         ; reserved for "does"
 245 ;; pfa:
 246 ;;   word data follows
 247 ;;
 248 ;; first word cell contains combined name length (low byte), argtype and flags (other bytes)
 249 ;; layout:
 250 ;;   db namelen
 251 ;;   db argtype
 252 ;;   dw flags
 253 ;; i.e. we have 16 bits for flags, and 256 possible argument types. why not.
 254 ;;
 255 ;; flags:
 256 ;;  bit 0: immediate
 257 ;;  bit 1: smudge
 258 ;;  bit 2: noreturn
 259 ;;  bit 3: hidden
 260 ;;  bit 4: codeblock
 261 ;;  bit 5: vocabulary
 262 ;;  bit 6: *UNUSED* main scattered colon word (with "...")
 263 ;;  bit 7: protected
 264 ;;  bit 8: conditional branch (has sense only for words with branch address)
 265 ;;  bit 9: may return, but may not (unreliable flag ;-)
 266 ;;
 267 ;;  argtype is the type of the argument that this word reads from the threaded code.
 268 ;;  possible argument types:
 269 ;;    0: none
 270 ;;    1: branch address
 271 ;;    2: cell-size numeric literal
 272 ;;    3: cell-counted string with terminating zero (not counted)
 273 ;;    4: cfa of another word
 274 ;;    5: cblock
 275 ;;    6: vocid
 276 ;;    7: byte-counted string with terminating zero (not counted)
 277 ;;    8: data skip: the arg is amout of bytes to skip (not including the counter itself)
 278 ;;    9: pfa address
 279
 280
 281 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 282 ;; wordlist structure (at PFA)
 283 ;; -4: wordlist type id (used by structs, for example)
 284 ;;   dd latest
 285 ;;   dd voclink (voclink always points here)
 286 ;;   dd parent (if not zero, all parent words are visible)
 287 ;;   dd header-nfa (can be 0 for anonymous wordlists)
 288 ;;   hashtable (if enabled), or ~0U if no hash table
 289 */
 290
 291
 292 // ////////////////////////////////////////////////////////////////////////// //
 293 #define UFO_BFA_TO_LFA(bfa_)    ((bfa_) + 1u * 4u)
 294 #define UFO_LFA_TO_XFA(lfa_)    ((lfa_) - 3u * 4u)
 295 #define UFO_LFA_TO_YFA(lfa_)    ((lfa_) - 2u * 4u)
 296 #define UFO_LFA_TO_BFA(lfa_)    ((lfa_) - 1u * 4u)
 297 #define UFO_LFA_TO_NFA(lfa_)    ((lfa_) + 2u * 4u)
 298 #define UFO_LFA_TO_CFA(lfa_)    UFO_ALIGN4((lfa_) + 3u * 4u + 1u + ufoImgGetU8((lfa_) + 2u * 4u))
 299 #define UFO_LFA_TO_NHASH(lfa_)  ((lfa_) + 1u * 4u)
 300 #define UFO_CFA_TO_NFA(cfa_)    ((cfa_) - 1u - 4u - ufoImgGetU8((cfa_) - 1u))
 301 #define UFO_CFA_TO_LFA(cfa_)    ((cfa_) - 1u - 4u * 3u - ufoImgGetU8((cfa_) - 1u))
 302 #define UFO_CFA_TO_PFA(cfa_)    ((cfa_) + 2u * 4u)
 303 #define UFO_PFA_TO_CFA(pfa_)    ((pfa_) - 2u * 4u)
 304 #define UFO_NFA_TO_CFA(nfa_)    UFO_ALIGN4((nfa_) + 4u + 1u + ufoImgGetU8((nfa_)))
 305 #define UFO_NFA_TO_LFA(nfa_)    ((nfa_) - 2u * 4u)
 306 #define UFO_XFA_TO_YFA(xfa_)    ((xfa_) + 4u)
 307 #define UFO_YFA_TO_XFA(yfa_)    ((xfa_) - 4u)
 308 #define UFO_YFA_TO_WST(yfa_)    ((yfa_) - 4u)  /* to xfa */
 309 #define UFO_YFA_TO_NFA(yfa_)    ((yfa_) + 4u * 4u)
 310
 311 #define UFO_CFA_TO_DOES_CFA(cfa_)  ((cfa_) + 4u)
 312 #define UFO_PFA_TO_DOES_CFA(pfa_)  ((pfa_) - 4u)
 313
 314
 315 // ////////////////////////////////////////////////////////////////////////// //
 316 #define UFW_VOCAB_OFS_LATEST   (0u * 4u)
 317 #define UFW_VOCAB_OFS_VOCLINK  (1u * 4u)
 318 #define UFW_VOCAB_OFS_PARENT   (2u * 4u)
 319 #define UFW_VOCAB_OFS_HEADER   (3u * 4u)
 320 #define UFW_VOCAB_OFS_HTABLE   (4u * 4u)
 321
 322 #define UFO_HASHTABLE_SIZE  (256)
 323
 324 #define UFO_NO_HTABLE_FLAG  (~(uint32_t)0)
 325
 326 #define UFO_MAX_NATIVE_CFAS  (1024u)
 327 static ufoNativeCFA ufoForthCFAs[UFO_MAX_NATIVE_CFAS];
 328 static uint32_t ufoCFAsUsed = 0;
 329
 330 static uint32_t ufoDoForthCFA;
 331 static uint32_t ufoDoVariableCFA;
 332 static uint32_t ufoDoValueCFA;
 333 static uint32_t ufoDoConstCFA;
 334 static uint32_t ufoDoDeferCFA;
 335 static uint32_t ufoDoDoesCFA;
 336 static uint32_t ufoDoRedirectCFA;
 337 static uint32_t ufoDoVocCFA;
 338 static uint32_t ufoDoCreateCFA;
 339 static uint32_t ufoDoUserVariableCFA;
 340
 341 static uint32_t ufoLitStr8CFA;
 342
 343 #ifdef UFO_MTASK_ALLOWED
 344 static uint32_t ufoSingleStepAllowed;
 345 #endif
 346
 347 // special address types:
 348 #define UFO_ADDR_CFA_BIT   ((uint32_t)1<<31)
 349 #define UFO_ADDR_CFA_MASK  (UFO_ADDR_CFA_BIT-1u)
 350
 351 // handles are somewhat special: first 12 bits can be used as offset for "@", and are ignored
 352 #define UFO_ADDR_HANDLE_BIT       ((uint32_t)1<<30)
 353 #define UFO_ADDR_HANDLE_MASK      ((UFO_ADDR_HANDLE_BIT-1u)&~((uint32_t)0xfff))
 354 #define UFO_ADDR_HANDLE_SHIFT     (12)
 355 #define UFO_ADDR_HANDLE_OFS_MASK  ((uint32_t)((1 << UFO_ADDR_HANDLE_SHIFT) - 1))
 356
 357 // temporary area is 1MB buffer out of the main image
 358 #define UFO_ADDR_TEMP_BIT   ((uint32_t)1<<29)
 359 #define UFO_ADDR_TEMP_MASK  (UFO_ADDR_TEMP_BIT-1u)
 360
 361 #define UFO_ADDR_SPECIAL_BITS_MASK  (UFO_ADDR_CFA_BIT|UFO_ADDR_HANDLE_BIT|UFO_ADDR_TEMP_BIT)
 362
 363
 364 #ifdef UFO_HUGE_IMAGES
 365 #define  ufoImageSize (1024u * 1024u * 64u)
 366 static uint32_t ufoImage[ufoImageSize / 4u];
 367 #else
 368 static uint32_t *ufoImage = NULL;
 369 static uint32_t ufoImageSize = 0;
 370 #endif
 371
 372 static uint8_t *ufoDebugImage = NULL;
 373 static uint32_t ufoDebugImageUsed = 0; // in bytes
 374 static uint32_t ufoDebugImageSize = 0; // in bytes
 375 static uint32_t ufoDebugFileNameHash = 0; // current file name hash
 376 static uint32_t ufoDebugFileNameLen = 0; // current file name length
 377 static uint32_t ufoDebugLastLine = 0;
 378 static uint32_t ufoDebugLastLinePCOfs = 0;
 379 static uint32_t ufoDebugLastLineDP = 0;
 380 static uint32_t ufoDebugCurrDP = 0;
 381
 382 static uint32_t ufoInRunWord = 0;
 383
 384 //static volatile int ufoVMAbort = 0;
 385
 386 #define ufoTrueValue  (~(uint32_t)0)
 387
 388 enum {
 389   UFO_MODE_NONE = -1,
 390   UFO_MODE_NATIVE = 0, // executing forth code
 391   UFO_MODE_MACRO = 1, // executing forth asm macro
 392 };
 393 static uint32_t ufoMode = UFO_MODE_NONE;
 394
 395 #define UFO_DSTACK_SIZE    (8192)
 396 #define UFO_RSTACK_SIZE    (4096)
 397 #define UFO_LSTACK_SIZE    (4096)
 398 #define UFO_MAX_TASK_NAME  (127)
 399 #define UFO_VOCSTACK_SIZE  (16u)
 400
 401 #define UFO_MAX_TEMP_IMAGE  (1024u * 1024u * 8u)
 402
 403 // to support multitasking (required for the debugger),
 404 // our virtual machine state is encapsulated in a struct.
 405 typedef struct UfoState_t {
 406   uint32_t id;
 407   uint32_t dStack[UFO_DSTACK_SIZE];
 408   uint32_t rStack[UFO_RSTACK_SIZE];
 409   uint32_t lStack[UFO_LSTACK_SIZE];
 410   uint32_t IP; // in image
 411   uint32_t SP; // points AFTER the last value pushed
 412   uint32_t RP; // points AFTER the last value pushed
 413   // address register
 414   uint32_t regA;
 415   // for locals
 416   uint32_t LP;
 417   uint32_t LBP;
 418   // vocstack
 419   uint32_t vocStack[UFO_VOCSTACK_SIZE]; // cfas
 420   uint32_t VSP;
 421   // temp image
 422   #ifdef UFO_HUGE_IMAGES
 423   uint32_t imageTemp[UFO_MAX_TEMP_IMAGE / 4u];
 424   #else
 425   uint32_t *imageTemp;
 426   uint32_t imageTempSize;
 427   #endif
 428   // linked list of all allocated states (tasks)
 429   char name[UFO_MAX_TASK_NAME + 1];
 430 } UfoState;
 431
 432 // 'cmon!
 433 #define UFO_MAX_STATES  (8192)
 434
 435 #ifdef UFO_MTASK_ALLOWED
 436 // this is indexed by id
 437 static UfoState *ufoStateMap[UFO_MAX_STATES] = {NULL};
 438 static uint32_t ufoStateUsedBitmap[UFO_MAX_STATES/32] = {0};
 439
 440 // currently active execution state
 441 static UfoState *ufoCurrState = NULL;
 442 // state we're yielded from
 443 static UfoState *ufoYieldedState = NULL;
 444 // if debug state is not NULL, VM will switch to it
 445 // after executing one instruction from the current state.
 446 // it will store current state in `ufoDebugeeState`.
 447 static UfoState *ufoDebuggerState = NULL;
 448 static uint32_t ufoSingleStep = 0;
 449
 450 #define ufoDStack         (ufoCurrState->dStack)
 451 #define ufoRStack         (ufoCurrState->rStack)
 452 #define ufoLStack         (ufoCurrState->lStack)
 453 #define ufoIP             (ufoCurrState->IP)
 454 #define ufoSP             (ufoCurrState->SP)
 455 #define ufoRP             (ufoCurrState->RP)
 456 #define ufoLP             (ufoCurrState->LP)
 457 #define ufoLBP            (ufoCurrState->LBP)
 458 #define ufoRegA           (ufoCurrState->regA)
 459 #define ufoImageTemp      (ufoCurrState->imageTemp)
 460 #ifdef UFO_HUGE_IMAGES
 461 # define ufoImageTempSize  UFO_MAX_TEMP_IMAGE
 462 # define ufoSTImageTempSize(st_)  UFO_MAX_TEMP_IMAGE
 463 #else
 464 # define ufoImageTempSize  (ufoCurrState->imageTempSize)
 465 # define ufoSTImageTempSize(st_)  ((st_)->imageTempSize)
 466 #endif
 467 #define ufoVocStack       (ufoCurrState->vocStack)
 468 #define ufoVSP            (ufoCurrState->VSP)
 469
 470 #else /* no multitasking */
 471
 472 static UfoState ufoCurrState;
 473
 474 #define ufoDStack         (ufoCurrState.dStack)
 475 #define ufoRStack         (ufoCurrState.rStack)
 476 #define ufoLStack         (ufoCurrState.lStack)
 477 #define ufoIP             (ufoCurrState.IP)
 478 #define ufoSP             (ufoCurrState.SP)
 479 #define ufoRP             (ufoCurrState.RP)
 480 #define ufoLP             (ufoCurrState.LP)
 481 #define ufoLBP            (ufoCurrState.LBP)
 482 #define ufoRegA           (ufoCurrState.regA)
 483 #define ufoImageTemp      (ufoCurrState.imageTemp)
 484 #ifdef UFO_HUGE_IMAGES
 485 # define ufoImageTempSize  UFO_MAX_TEMP_IMAGE
 486 # define ufoSTImageTempSize(st_)  UFO_MAX_TEMP_IMAGE
 487 #else
 488 # define ufoImageTempSize  (ufoCurrState.imageTempSize)
 489 # define ufoSTImageTempSize(st_)  ((st_)->imageTempSize)
 490 #endif
 491 #define ufoVocStack       (ufoCurrState.vocStack)
 492 #define ufoVSP            (ufoCurrState.VSP)
 493
 494 #endif
 495
 496 static jmp_buf ufoStopVMJP;
 497
 498 // 256 bytes for user variables
 499 #define UFO_USER_AREA_ADDR  UFO_ADDR_TEMP_BIT
 500 #define UFO_USER_AREA_SIZE  (256u)
 501 #define UFO_NBUF_ADDR       UFO_USER_AREA_ADDR + UFO_USER_AREA_SIZE
 502 #define UFO_NBUF_SIZE       (256u)
 503 #define UFO_PAD_ADDR        (UFO_NBUF_ADDR + UFO_NBUF_SIZE)
 504 #define UFO_DEF_TIB_ADDR    (UFO_PAD_ADDR + 2048u)
 505
 506 // dynamically allocated text input buffer
 507 // always ends with zero (this is word name too)
 508 static const uint32_t ufoAddrTIBx = UFO_ADDR_TEMP_BIT + 0u * 4u; // TIB
 509 static const uint32_t ufoAddrINx = UFO_ADDR_TEMP_BIT + 1u * 4u; // >IN
 510 static const uint32_t ufoAddrDefTIB = UFO_ADDR_TEMP_BIT + 2u * 4u; // default TIB (handle); user cannot change it
 511 static const uint32_t ufoAddrBASE = UFO_ADDR_TEMP_BIT + 3u * 4u;
 512 static const uint32_t ufoAddrSTATE = UFO_ADDR_TEMP_BIT + 4u * 4u;
 513 static const uint32_t ufoAddrContext = UFO_ADDR_TEMP_BIT + 5u * 4u; // CONTEXT
 514 static const uint32_t ufoAddrCurrent = UFO_ADDR_TEMP_BIT + 6u * 4u; // CURRENT (definitions will go there)
 515 static const uint32_t ufoAddrSelf = UFO_ADDR_TEMP_BIT + 7u * 4u; // CURRENT (definitions will go there)
 516 static const uint32_t ufoAddrInterNextLine = UFO_ADDR_TEMP_BIT + 8u * 4u; // (INTERPRET-NEXT-LINE)
 517 static const uint32_t ufoAddrEP = UFO_ADDR_TEMP_BIT + 9u * 4u; // (EP) -- exception frame pointer
 518 static const uint32_t ufoAddrDPTemp = UFO_ADDR_TEMP_BIT + 10u * 4u; // pointer to currently active DP in temp dict
 519 static const uint32_t ufoAddrHereDP = UFO_ADDR_TEMP_BIT + 11u * 4u; // pointer to currently active DP for HERE
 520 static const uint32_t ufoAddrUserVarUsed = UFO_ADDR_TEMP_BIT + 12u * 4u;
 521
 522 #define UFO_DPTEMP_BASE_ADDR  (UFO_ADDR_TEMP_BIT + 256u * 1024u)
 523
 524 static uint32_t ufoAddrVocLink;
 525 static uint32_t ufoAddrDP; // DP for main dict
 526 static uint32_t ufoAddrNewWordFlags;
 527 static uint32_t ufoAddrRedefineWarning;
 528 static uint32_t ufoAddrLastXFA;
 529
 530 static uint32_t ufoForthVocId;
 531 static uint32_t ufoCompilerVocId;
 532 static uint32_t ufoInterpNextLineCFA;
 533
 534 static uint32_t ufoUserAbortCFA;
 535
 536 // allows to redefine even protected words
 537 #define UFO_REDEF_WARN_DONT_CARE  (~(uint32_t)0)
 538 // do not warn about ordinary words, allow others
 539 #define UFO_REDEF_WARN_NONE    (0)
 540 // do warn (or fail on protected)
 541 #define UFO_REDEF_WARN_NORMAL  (1)
 542 // do warn (or fail on protected) for parent dicts too
 543 #define UFO_REDEF_WARN_PARENTS (2)
 544
 545 #define UFO_GET_DP()      (ufoImgGetU32(ufoImgGetU32(ufoAddrHereDP)))
 546
 547 #define UFO_MAX_NESTED_INCLUDES  (32)
 548 typedef struct {
 549   FILE *fl;
 550   char *fname;
 551   char *incpath;
 552   char *sysincpath;
 553   int fline;
 554   uint32_t id; // non-zero unique id
 555 } UFOFileStackEntry;
 556
 557 static UFOFileStackEntry ufoFileStack[UFO_MAX_NESTED_INCLUDES];
 558 static uint32_t ufoFileStackPos; // after the last used item
 559
 560 static FILE *ufoInFile = NULL;
 561 static uint32_t ufoInFileNameLen = 0;
 562 static uint32_t ufoInFileNameHash = 0;
 563 static char *ufoInFileName = NULL;
 564 static char *ufoLastIncPath = NULL;
 565 static char *ufoLastSysIncPath = NULL;
 566 static int ufoInFileLine = 0;
 567 static uint32_t ufoFileId = 0;
 568 static uint32_t ufoLastUsedFileId = 0;
 569 static int ufoLastEmitWasCR = 1;
 570 static long ufoCurrIncludeLineFileOfs = 0;
 571
 572 // dynamic memory handles
 573 typedef struct UHandleInfo_t {
 574   uint32_t ufoHandle;
 575   uint32_t typeid;
 576   uint8_t *data;
 577   uint32_t size;
 578   uint32_t used;
 579   // in free list
 580   struct UHandleInfo_t *next;
 581 } UfoHandle;
 582
 583 static UfoHandle *ufoHandleFreeList = NULL;
 584 static UfoHandle **ufoHandles = NULL;
 585 static uint32_t ufoHandlesUsed = 0;
 586 static uint32_t ufoHandlesAlloted = 0;
 587
 588 #define UFO_HANDLE_FREE  (~(uint32_t)0)
 589
 590 static char ufoCurrFileLine[520];
 591
 592 // for `ufoFatal()`
 593 static uint32_t ufoInBacktrace = 0;
 594
 595
 596 // ////////////////////////////////////////////////////////////////////////// //
 597 static void ufoClearCondDefines (void);
 598
 599 static void ufoBacktrace (uint32_t ip, int showDataStack);
 600 static void ufoBTShowWordName (uint32_t nfa);
 601
 602 static void ufoClearCondDefines (void);
 603
 604 #ifdef UFO_MTASK_ALLOWED
 605 static UfoState *ufoNewState (void);
 606 static void ufoFreeState (UfoState *st);
 607 static UfoState *ufoFindState (uint32_t stid);
 608 static void ufoSwitchToState (UfoState *newst);
 609 #endif
 610 static void ufoInitStateUserVars (UfoState *st);
 611
 612 __attribute__((unused)) static void ufoDumpWordHeader (const uint32_t lfa);
 613
 614 #ifndef WIN32
 615 static void ufoDisableRaw (void);
 616 #endif
 617 static void ufoTTYRawFlush (void);
 618 static int ufoIsGoodTTY (void);
 619
 620 #ifdef UFO_DEBUG_DEBUG
 621 static void ufoDumpDebugImage (void);
 622 #endif
 623
 624
 625 // ////////////////////////////////////////////////////////////////////////// //
 626 #ifdef UFO_MTASK_ALLOWED
 627 #define UFO_EXEC_CFA(cfa_)  do { \
 628   const uint32_t cfa = (cfa_); \
 629   if (ufoCurrState == NULL) ufoFatal("execution state is lost"); \
 630   const uint32_t cfaidx = ufoImgGetU32(cfa); \
 631   if (cfaidx >= UFO_ADDR_CFA_BIT && cfaidx < UFO_MAX_NATIVE_CFAS + UFO_ADDR_CFA_BIT) { \
 632     ufoForthCFAs[cfaidx & UFO_ADDR_CFA_MASK](UFO_CFA_TO_PFA(cfa)); \
 633   } else { \
 634     ufoFatal("tried to execute an unknown word: %u (max is %u); IP=%u", cfaidx, ufoCFAsUsed, ufoIP - 4u); \
 635   } \
 636   /* that's all we need to activate the debugger */ \
 637   if (ufoSingleStep) { \
 638     ufoSingleStep -= 1; \
 639     if (ufoSingleStep == 0 && ufoDebuggerState != NULL) { \
 640       if (ufoCurrState == ufoDebuggerState) ufoFatal("debugger cannot debug itself"); \
 641       UfoState *ost = ufoCurrState; \
 642       ufoSwitchToState(ufoDebuggerState); /* always use API call for this! */ \
 643       ufoPush(-2); \
 644       ufoPush(ost->id); \
 645     } \
 646   } \
 647 } while (0)
 648
 649 #else
 650
 651 #if 0
 652 # define UFO_EXEC_CFA_DEBUG  do { \
 653   fprintf(stderr, "IP:%08X CFA:%08X (CFA):%08X\n", ufoIP, xxcfa, xxcfaidx); \
 654   uint32_t nfa = ufoFindWordForIP(ufoIP - 4u); \
 655   if (nfa != 0) { \
 656     fprintf(stderr, "  IP: "); ufoBTShowWordName(nfa); \
 657     /*fname = ufoFindFileForIP(ip, &fline, NULL, NULL);*/ \
 658     /*if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }*/ \
 659     fputc('\n', stderr); \
 660   } \
 661   nfa = ufoFindWordForIP(xxcfa); \
 662   if (nfa != 0) { \
 663     fprintf(stderr, "  CFA:"); ufoBTShowWordName(nfa); \
 664     /*fname = ufoFindFileForIP(ip, &fline, NULL, NULL);*/ \
 665     /*if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }*/ \
 666     fputc('\n', stderr); \
 667   } \
 668 } while (0);
 669 #else
 670 # define UFO_EXEC_CFA_DEBUG
 671 #endif
 672
 673 #define UFO_EXEC_CFA(cfa__)  do { \
 674   const uint32_t xxcfa = (cfa__); \
 675   const uint32_t xxcfaidx = ufoImgGetU32(xxcfa); \
 676   UFO_EXEC_CFA_DEBUG \
 677   if (xxcfaidx >= UFO_ADDR_CFA_BIT && xxcfaidx < UFO_MAX_NATIVE_CFAS + UFO_ADDR_CFA_BIT) { \
 678     ufoForthCFAs[xxcfaidx & UFO_ADDR_CFA_MASK](UFO_CFA_TO_PFA(xxcfa)); \
 679   } else { \
 680     ufoFatal("tried to execute an unknown word: %u (max is %u); IP=%u; CFA=%u", \
 681              xxcfaidx, ufoCFAsUsed, ufoIP - 4u, xxcfa); \
 682   } \
 683 } while (0)
 684
 685 #endif
 686
 687
 688 // ////////////////////////////////////////////////////////////////////////// //
 689 #define UFWORD(name_) \
 690 static void ufoWord_##name_ (uint32_t mypfa)
 691
 692 #define UFCALL(name_)  ufoWord_##name_(0)
 693 #define UFCFA(name_)   (&ufoWord_##name_)
 694
 695 // for TIB words
 696 UFWORD(CPOKE_REGA_IDX);
 697
 698 // for peek and poke
 699 UFWORD(PAR_HANDLE_LOAD_BYTE);
 700 UFWORD(PAR_HANDLE_LOAD_WORD);
 701 UFWORD(PAR_HANDLE_LOAD_CELL);
 702 UFWORD(PAR_HANDLE_STORE_BYTE);
 703 UFWORD(PAR_HANDLE_STORE_WORD);
 704 UFWORD(PAR_HANDLE_STORE_CELL);
 705
 706
 707 //==========================================================================
 708 //
 709 //  ufoFlushOutput
 710 //
 711 //==========================================================================
 712 static void ufoFlushOutput (void) {
 713   ufoTTYRawFlush();
 714   fflush(NULL);
 715 }
 716
 717
 718 //==========================================================================
 719 //
 720 //  ufoSetInFileName
 721 //
 722 //  if `reuse` is not 0, reuse/free `fname`
 723 //
 724 //==========================================================================
 725 static void ufoSetInFileNameEx (const char *fname, int reuse) {
 726   ufo_assert(fname == NULL || (fname != ufoInFileName));
 727   if (fname == NULL || fname[0] == 0) {
 728     if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
 729     ufoInFileNameLen = 0;
 730     ufoInFileNameHash = 0;
 731     if (reuse && fname != NULL) free((void *)fname);
 732   } else {
 733     const uint32_t fnlen = (uint32_t)strlen(fname);
 734     const uint32_t fnhash = joaatHashBuf(fname, fnlen, 0);
 735     if (ufoInFileNameLen != fnlen || ufoInFileNameHash != fnhash) {
 736       if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
 737       if (reuse) {
 738         ufoInFileName = (char *)fname;
 739       } else {
 740         ufoInFileName = strdup(fname);
 741         if (ufoInFileName == NULL) ufoFatal("out of memory for filename info");
 742       }
 743       ufoInFileNameLen = fnlen;
 744       ufoInFileNameHash = fnhash;
 745     } else {
 746       if (reuse && fname != NULL) free((void *)fname);
 747     }
 748   }
 749 }
 750
 751
 752 //==========================================================================
 753 //
 754 //  ufoSetInFileName
 755 //
 756 //==========================================================================
 757 UFO_FORCE_INLINE void ufoSetInFileName (const char *fname) {
 758   ufoSetInFileNameEx(fname, 0);
 759 }
 760
 761
 762 //==========================================================================
 763 //
 764 //  ufoSetInFileNameReuse
 765 //
 766 //==========================================================================
 767 UFO_FORCE_INLINE void ufoSetInFileNameReuse (const char *fname) {
 768   ufoSetInFileNameEx(fname, 1);
 769 }
 770
 771
 772 //==========================================================================
 773 //
 774 //  ufoAllocHandle
 775 //
 776 //==========================================================================
 777 static UfoHandle *ufoAllocHandle (uint32_t typeid) {
 778   ufo_assert(typeid != UFO_HANDLE_FREE);
 779   UfoHandle *newh = ufoHandleFreeList;
 780   if (newh == NULL) {
 781     if (ufoHandlesUsed == ufoHandlesAlloted) {
 782       uint32_t newsz = ufoHandlesAlloted + 16384;
 783       // due to offsets, this is the maximum number of handles we can have
 784       if (newsz > 0x1ffffU) {
 785         if (ufoHandlesAlloted > 0x1ffffU) ufoFatal("too many dynamic handles");
 786         newsz = 0x1ffffU + 1U;
 787         ufo_assert(newsz > ufoHandlesAlloted);
 788       }
 789       UfoHandle **nh = realloc(ufoHandles, sizeof(ufoHandles[0]) * newsz);
 790       if (nh == NULL) ufoFatal("out of memory for handle table");
 791       ufoHandles = nh;
 792       ufoHandlesAlloted = newsz;
 793     }
 794     newh = calloc(1, sizeof(UfoHandle));
 795     if (newh == NULL) ufoFatal("out of memory for handle info");
 796     ufoHandles[ufoHandlesUsed] = newh;
 797     // setup new handle info
 798     newh->ufoHandle = (ufoHandlesUsed << UFO_ADDR_HANDLE_SHIFT) | UFO_ADDR_HANDLE_BIT;
 799     ufoHandlesUsed += 1;
 800   } else {
 801     ufo_assert(newh->typeid == UFO_HANDLE_FREE);
 802     ufoHandleFreeList = newh->next;
 803   }
 804   // setup new handle info
 805   newh->typeid = typeid;
 806   newh->data = NULL;
 807   newh->size = 0;
 808   newh->used = 0;
 809   newh->next = NULL;
 810   return newh;
 811 }
 812
 813
 814 //==========================================================================
 815 //
 816 //  ufoFreeHandle
 817 //
 818 //==========================================================================
 819 static void ufoFreeHandle (UfoHandle *hh) {
 820   if (hh != NULL) {
 821     ufo_assert(hh->typeid != UFO_HANDLE_FREE);
 822     if (hh->data) free(hh->data);
 823     hh->typeid = UFO_HANDLE_FREE;
 824     hh->data = NULL;
 825     hh->size = 0;
 826     hh->used = 0;
 827     hh->next = ufoHandleFreeList;
 828     ufoHandleFreeList = hh;
 829   }
 830 }
 831
 832
 833 //==========================================================================
 834 //
 835 //  ufoGetHandle
 836 //
 837 //==========================================================================
 838 static UfoHandle *ufoGetHandle (uint32_t hh) {
 839   UfoHandle *res;
 840   if (hh != 0 && (hh & UFO_ADDR_HANDLE_BIT) != 0) {
 841     hh = (hh & UFO_ADDR_HANDLE_MASK) >> UFO_ADDR_HANDLE_SHIFT;
 842     if (hh < ufoHandlesUsed) {
 843       res = ufoHandles[hh];
 844       if (res->typeid == UFO_HANDLE_FREE) res = NULL;
 845     } else {
 846       res = NULL;
 847     }
 848   } else {
 849     res = NULL;
 850   }
 851   return res;
 852 }
 853
 854
 855 #define POP_PREPARE_HANDLE_XX() \
 856   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle"); \
 857   if (idx > 0x1fffffffU - UFO_ADDR_HANDLE_OFS_MASK) ufoFatal("handle index %u out of range", idx); \
 858   idx += (hx & UFO_ADDR_HANDLE_OFS_MASK); \
 859   UfoHandle *hh = ufoGetHandle(hx); \
 860   if (hh == NULL) ufoFatal("invalid handle")
 861
 862 UFO_DISABLE_INLINE uint32_t ufoHandleLoadByte (uint32_t hx, uint32_t idx) {
 863   POP_PREPARE_HANDLE_XX();
 864   if (idx >= hh->size) ufoFatal("handle index %u out of range (%u)", idx, hh->size);
 865   return hh->data[idx];
 866 }
 867
 868 UFO_DISABLE_INLINE uint32_t ufoHandleLoadWord (uint32_t hx, uint32_t idx) {
 869   POP_PREPARE_HANDLE_XX();
 870   if (idx >= hh->size || hh->size - idx < 2u) {
 871     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
 872   }
 873   #ifdef UFO_FAST_MEM_ACCESS
 874   return *(const uint16_t *)(hh->data + idx);
 875   #else
 876   uint32_t res = hh->data[idx];
 877   res |= hh->data[idx + 1u] << 8;
 878   return res;
 879   #endif
 880 }
 881
 882 UFO_DISABLE_INLINE uint32_t ufoHandleLoadCell (uint32_t hx, uint32_t idx) {
 883   POP_PREPARE_HANDLE_XX();
 884   if (idx >= hh->size || hh->size - idx < 4u) {
 885     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
 886   }
 887   #ifdef UFO_FAST_MEM_ACCESS
 888   return *(const uint32_t *)(hh->data + idx);
 889   #else
 890   uint32_t res = hh->data[idx];
 891   res |= hh->data[idx + 1u] << 8;
 892   res |= hh->data[idx + 2u] << 16;
 893   res |= hh->data[idx + 3u] << 24;
 894   return res;
 895   #endif
 896 }
 897
 898 UFO_DISABLE_INLINE void ufoHandleStoreByte (uint32_t hx, uint32_t idx, uint32_t value) {
 899   POP_PREPARE_HANDLE_XX();
 900   if (idx >= hh->size) ufoFatal("handle index %u out of range (%u)", idx, hh->size);
 901   hh->data[idx] = (uint8_t)value;
 902 }
 903
 904 UFO_DISABLE_INLINE void ufoHandleStoreWord (uint32_t hx, uint32_t idx, uint32_t value) {
 905   POP_PREPARE_HANDLE_XX();
 906   if (idx >= hh->size || hh->size - idx < 2u) {
 907     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
 908   }
 909   #ifdef UFO_FAST_MEM_ACCESS
 910   *(uint16_t *)(hh->data + idx) = (uint16_t)value;
 911   #else
 912   hh->data[idx] = (uint8_t)value;
 913   hh->data[idx + 1u] = (uint8_t)(value >> 8);
 914   #endif
 915 }
 916
 917 UFO_DISABLE_INLINE void ufoHandleStoreCell (uint32_t hx, uint32_t idx, uint32_t value) {
 918   POP_PREPARE_HANDLE_XX();
 919   if (idx >= hh->size || hh->size - idx < 4u) {
 920     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
 921   }
 922   #ifdef UFO_FAST_MEM_ACCESS
 923   *(uint32_t *)(hh->data + idx) = value;
 924   #else
 925   hh->data[idx] = (uint8_t)value;
 926   hh->data[idx + 1u] = (uint8_t)(value >> 8);
 927   hh->data[idx + 2u] = (uint8_t)(value >> 16);
 928   hh->data[idx + 3u] = (uint8_t)(value >> 24);
 929   #endif
 930 }
 931
 932
 933 //==========================================================================
 934 //
 935 //  setLastIncPath
 936 //
 937 //==========================================================================
 938 static void setLastIncPath (const char *fname, int system) {
 939   if (fname == NULL || fname[0] == 0) {
 940     if (system) {
 941       if (ufoLastSysIncPath) free(ufoLastIncPath);
 942       ufoLastSysIncPath = NULL;
 943     } else {
 944       if (ufoLastIncPath) free(ufoLastIncPath);
 945       ufoLastIncPath = strdup(".");
 946     }
 947   } else {
 948     char *lslash;
 949     char *cpos;
 950     if (system) {
 951       if (ufoLastSysIncPath) free(ufoLastSysIncPath);
 952       ufoLastSysIncPath = strdup(fname);
 953       lslash = ufoLastSysIncPath;
 954       cpos = ufoLastSysIncPath;
 955     } else {
 956       if (ufoLastIncPath) free(ufoLastIncPath);
 957       ufoLastIncPath = strdup(fname);
 958       lslash = ufoLastIncPath;
 959       cpos = ufoLastIncPath;
 960     }
 961     while (*cpos) {
 962       #ifdef WIN32
 963       if (*cpos == '/' || *cpos == '\\') lslash = cpos;
 964       #else
 965       if (*cpos == '/') lslash = cpos;
 966       #endif
 967       cpos += 1;
 968     }
 969     *lslash = 0;
 970   }
 971 }
 972
 973
 974 //==========================================================================
 975 //
 976 //  ufoClearIncludePath
 977 //
 978 //  required for UrAsm
 979 //
 980 //==========================================================================
 981 void ufoClearIncludePath (void) {
 982   if (ufoLastIncPath != NULL) {
 983     free(ufoLastIncPath);
 984     ufoLastIncPath = NULL;
 985   }
 986   if (ufoLastSysIncPath != NULL) {
 987     free(ufoLastSysIncPath);
 988     ufoLastSysIncPath = NULL;
 989   }
 990 }
 991
 992
 993 //==========================================================================
 994 //
 995 //  ufoErrorPrintFile
 996 //
 997 //==========================================================================
 998 static void ufoErrorPrintFile (FILE *fo, const char *errwarn) {
 999   if (ufoInFileName != NULL) {
1000     fprintf(fo, "UFO %s at file %s, line %d: ", errwarn, ufoInFileName, ufoInFileLine);
1001   } else {
1002     fprintf(fo, "UFO %s somewhere in time: ", errwarn);
1003   }
1004 }
1005
1006
1007 //==========================================================================
1008 //
1009 //  ufoErrorMsgV
1010 //
1011 //==========================================================================
1012 static void ufoErrorMsgV (const char *errwarn, const char *fmt, va_list ap) {
1013   ufoFlushOutput();
1014   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
1015   ufoErrorPrintFile(stderr, errwarn);
1016   vfprintf(stderr, fmt, ap);
1017   va_end(ap);
1018   fputc('\n', stderr);
1019   ufoFlushOutput();
1020 }
1021
1022
1023 //==========================================================================
1024 //
1025 //  ufoWarning
1026 //
1027 //==========================================================================
1028 __attribute__((format(printf, 1, 2)))
1029 void ufoWarning (const char *fmt, ...) {
1030   va_list ap;
1031   va_start(ap, fmt);
1032   ufoErrorMsgV("WARNING", fmt, ap);
1033 }
1034
1035
1036 //==========================================================================
1037 //
1038 //  ufoFatal
1039 //
1040 //==========================================================================
1041 __attribute__((noreturn)) __attribute__((format(printf, 1, 2)))
1042 void ufoFatal (const char *fmt, ...) {
1043   va_list ap;
1044   #ifndef WIN32
1045   ufoDisableRaw();
1046   #endif
1047   va_start(ap, fmt);
1048   ufoErrorMsgV("ERROR", fmt, ap);
1049   if (!ufoInBacktrace) {
1050     ufoInBacktrace = 1;
1051     ufoBacktrace(ufoIP, 1);
1052     ufoInBacktrace = 0;
1053   } else {
1054     fprintf(stderr, "DOUBLE FATAL: error in backtrace!\n");
1055     abort();
1056   }
1057   #ifdef UFO_DEBUG_FATAL_ABORT
1058   abort();
1059   #endif
1060   // allow restart
1061   ufoInRunWord = 0;
1062   ufoFatalError();
1063 }
1064
1065
1066 // ////////////////////////////////////////////////////////////////////////// //
1067 // working with the stacks
1068 #define UFO_TOS    (ufoDStack[ufoSP - 1u])
1069 #define UFO_RTOS   (ufoRStack[ufoRP - 1u])
1070
1071 #define UFO_S(n_)    (ufoDStack[ufoSP - 1u - (n_)])
1072 #define UFO_R(n_)    (ufoRStack[ufoRP - 1u - (n_)])
1073
1074 #define UFO_STACK(n_)   if (ufoSP < (uint32_t)(n_)) ufoFatal("data stack underflow")
1075 #define UFO_RSTACK(n_)  if (ufoRP < (uint32_t)(n_)) ufoFatal("return stack underflow")
1076
1077 UFO_FORCE_INLINE void ufoPush (uint32_t v) { if (ufoSP >= UFO_DSTACK_SIZE) ufoFatal("data stack overflow"); ufoDStack[ufoSP++] = v; }
1078 UFO_FORCE_INLINE void ufoDrop (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); ufoSP -= 1u; }
1079 UFO_FORCE_INLINE uint32_t ufoPop (void) { if (ufoSP == 0) { ufoFatal("data stack underflow"); } return ufoDStack[--ufoSP]; }
1080 UFO_FORCE_INLINE uint32_t ufoPeek (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); return ufoDStack[ufoSP-1u]; }
1081 UFO_FORCE_INLINE void ufoDup (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); ufoPush(ufoDStack[ufoSP-1u]); }
1082 UFO_FORCE_INLINE void ufoOver (void) { if (ufoSP < 2u) ufoFatal("data stack underflow"); ufoPush(ufoDStack[ufoSP-2u]); }
1083 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; }
1084 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; }
1085 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; }
1086
1087 UFO_FORCE_INLINE void ufo2Dup (void) { ufoOver(); ufoOver(); }
1088 UFO_FORCE_INLINE void ufo2Drop (void) { UFO_STACK(2); ufoSP -= 2u; }
1089 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); }
1090 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; }
1091
1092 UFO_FORCE_INLINE void ufoRPush (uint32_t v) { if (ufoRP >= UFO_RSTACK_SIZE) ufoFatal("return stack overflow"); ufoRStack[ufoRP++] = v; }
1093 UFO_FORCE_INLINE void ufoRDrop (void) { if (ufoRP == 0) ufoFatal("return stack underflow"); --ufoRP; }
1094 UFO_FORCE_INLINE uint32_t ufoRPop (void) { if (ufoRP == 0) ufoFatal("return stack underflow"); return ufoRStack[--ufoRP]; }
1095 UFO_FORCE_INLINE uint32_t ufoRPeek (void) { if (ufoRP == 0) ufoFatal("return stack underflow"); return ufoRStack[ufoRP-1u]; }
1096 UFO_FORCE_INLINE void ufoRDup (void) { if (ufoRP == 0) ufoFatal("return stack underflow"); ufoPush(ufoRStack[ufoRP-1u]); }
1097
1098 UFO_FORCE_INLINE void ufoPushBool (int v) { ufoPush(v ? ufoTrueValue : 0u); }
1099
1100
1101 #ifndef UFO_HUGE_IMAGES
1102 //==========================================================================
1103 //
1104 //  ufoImgEnsureSize
1105 //
1106 //==========================================================================
1107 static void ufoImgEnsureSize (uint32_t addr) {
1108   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) != 0) ufoFatal("ufoImgEnsureSize: internal error");
1109   if (addr >= ufoImageSize) {
1110     // 64MB should be enough for everyone!
1111     if (addr >= 0x04000000U) {
1112       ufoFatal("image grown too big (addr=0%08XH)", addr);
1113     }
1114     const uint32_t osz = ufoImageSize;
1115     // grow by 1MB steps
1116     const uint32_t nsz = (addr|0x000fffffU) + 1U;
1117     ufo_assert(nsz > addr);
1118     uint32_t *nimg = realloc(ufoImage, nsz);
1119     if (nimg == NULL) {
1120       ufoFatal("out of memory for UFO image (%u -> %u MBs)",
1121                ufoImageSize / 1024u / 1024u,
1122                nsz / 1024u / 1024u);
1123     }
1124     ufoImage = nimg;
1125     ufoImageSize = nsz;
1126     memset((char *)ufoImage + osz, 0, (nsz - osz));
1127   }
1128 }
1129
1130
1131 //==========================================================================
1132 //
1133 //  ufoImgEnsureTemp
1134 //
1135 //==========================================================================
1136 static void ufoImgEnsureTemp (uint32_t addr) {
1137   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) != 0) ufoFatal("ufoImgEnsureTemp: internal error");
1138   if (addr >= ufoImageTempSize) {
1139     if (addr >= 1024u * 1024u) {
1140       ufoFatal("Forth segmentation fault at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1141     }
1142     const uint32_t osz = ufoImageTempSize;
1143     // grow by 64KB steps
1144     const uint32_t nsz = (addr|0x0000ffffU) + 1U;
1145     uint32_t *nimg = realloc(ufoImageTemp, nsz);
1146     if (nimg == NULL) {
1147       ufoFatal("out of memory for temp UFO image (%u -> %u KBs)",
1148                ufoImageTempSize / 1024u,
1149                nsz / 1024u);
1150     }
1151     ufoImageTemp = nimg;
1152     ufoImageTempSize = nsz;
1153     memset((char *)ufoImageTemp + osz, 0, (nsz - osz));
1154   }
1155 }
1156 #endif
1157
1158
1159 #ifdef UFO_FAST_MEM_ACCESS
1160 //==========================================================================
1161 //
1162 //  ufoImgPutU8
1163 //
1164 //  fast
1165 //
1166 //==========================================================================
1167 UFO_FORCE_INLINE void ufoImgPutU8 (uint32_t addr, const uint32_t value) {
1168   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1169     if (addr >= ufoImageSize) {
1170       #ifdef UFO_HUGE_IMAGES
1171       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1172       #else
1173       ufoImgEnsureSize(addr);
1174       #endif
1175     }
1176     *((uint8_t *)ufoImage + addr) = (uint8_t)value;
1177   } else if (addr & UFO_ADDR_TEMP_BIT) {
1178     addr &= UFO_ADDR_TEMP_MASK;
1179     if (addr >= ufoImageTempSize) {
1180       #ifdef UFO_HUGE_IMAGES
1181       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1182       #else
1183       ufoImgEnsureTemp(addr);
1184       #endif
1185     }
1186     *((uint8_t *)ufoImageTemp + addr) = (uint8_t)value;
1187   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1188     ufoHandleStoreByte(addr, 0, value);
1189   } else {
1190     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1191   }
1192 }
1193
1194
1195 //==========================================================================
1196 //
1197 //  ufoImgPutU16
1198 //
1199 //  fast
1200 //
1201 //==========================================================================
1202 UFO_FORCE_INLINE void ufoImgPutU16 (uint32_t addr, const uint32_t value) {
1203   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1204     if (addr + 1u >= ufoImageSize) {
1205       #ifdef UFO_HUGE_IMAGES
1206       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1207       #else
1208       ufoImgEnsureSize(addr + 1u);
1209       #endif
1210     }
1211     *(uint16_t *)((uint8_t *)ufoImage + addr) = (uint16_t)value;
1212   } else if (addr & UFO_ADDR_TEMP_BIT) {
1213     addr &= UFO_ADDR_TEMP_MASK;
1214     if (addr + 1u >= ufoImageTempSize) {
1215       #ifdef UFO_HUGE_IMAGES
1216       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1217       #else
1218       ufoImgEnsureTemp(addr + 1u);
1219       #endif
1220     }
1221     *(uint16_t *)((uint8_t *)ufoImageTemp + addr) = (uint16_t)value;
1222   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1223     ufoHandleStoreWord(addr, 0, value);
1224   } else {
1225     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1226   }
1227 }
1228
1229
1230 //==========================================================================
1231 //
1232 //  ufoImgPutU32
1233 //
1234 //  fast
1235 //
1236 //==========================================================================
1237 UFO_FORCE_INLINE void ufoImgPutU32 (uint32_t addr, const uint32_t value) {
1238   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1239     if (addr + 3u >= ufoImageSize) {
1240       #ifdef UFO_HUGE_IMAGES
1241       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1242       #else
1243       ufoImgEnsureSize(addr + 3u);
1244       #endif
1245     }
1246     *(uint32_t *)((uint8_t *)ufoImage + addr) = value;
1247   } else if (addr & UFO_ADDR_TEMP_BIT) {
1248     addr &= UFO_ADDR_TEMP_MASK;
1249     if (addr + 3u >= ufoImageTempSize) {
1250       #ifdef UFO_HUGE_IMAGES
1251       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1252       #else
1253       ufoImgEnsureTemp(addr + 3u);
1254       #endif
1255     }
1256     *(uint32_t *)((uint8_t *)ufoImageTemp + addr) = value;
1257   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1258     ufoHandleStoreCell(addr, 0, value);
1259   } else {
1260     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1261   }
1262 }
1263
1264
1265 //==========================================================================
1266 //
1267 //  ufoImgIOPtrU32
1268 //
1269 //  fast
1270 //
1271 //==========================================================================
1272 UFO_FORCE_INLINE uint32_t *ufoImgIOPtrU32 (uint32_t addr) {
1273   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1274     if (addr + 3u >= ufoImageSize) {
1275       #ifdef UFO_HUGE_IMAGES
1276       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1277       #else
1278       ufoImgEnsureSize(addr + 3u);
1279       #endif
1280     }
1281     return (uint32_t *)((uint8_t *)ufoImage + addr);
1282   } else if (addr & UFO_ADDR_TEMP_BIT) {
1283     addr &= UFO_ADDR_TEMP_MASK;
1284     if (addr + 3u >= ufoImageTempSize) {
1285       #ifdef UFO_HUGE_IMAGES
1286       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1287       #else
1288       ufoImgEnsureTemp(addr + 3u);
1289       #endif
1290     }
1291     return (uint32_t *)((uint8_t *)ufoImageTemp + addr);
1292   } else {
1293     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1294   }
1295 }
1296
1297
1298 //==========================================================================
1299 //
1300 //  ufoImgGetU8
1301 //
1302 //  false
1303 //
1304 //==========================================================================
1305 UFO_FORCE_INLINE uint32_t ufoImgGetU8 (uint32_t addr) {
1306   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1307     if (addr >= ufoImageSize) {
1308       // accessing unallocated image area is segmentation fault
1309       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1310     }
1311     return *((const uint8_t *)ufoImage + addr);
1312   } else if (addr & UFO_ADDR_TEMP_BIT) {
1313     addr &= UFO_ADDR_TEMP_MASK;
1314     if (addr >= ufoImageTempSize) {
1315       // accessing unallocated image area is segmentation fault
1316       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1317     }
1318     return *((const uint8_t *)ufoImageTemp + addr);
1319   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1320     return ufoHandleLoadByte(addr, 0);
1321   } else {
1322     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1323   }
1324 }
1325
1326
1327 //==========================================================================
1328 //
1329 //  ufoImgGetU16
1330 //
1331 //  fast
1332 //
1333 //==========================================================================
1334 UFO_FORCE_INLINE uint32_t ufoImgGetU16 (uint32_t addr) {
1335   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1336     if (addr + 1u >= ufoImageSize) {
1337       // accessing unallocated image area is segmentation fault
1338       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1339     }
1340     return *(const uint16_t *)((const uint8_t *)ufoImage + addr);
1341   } else if (addr & UFO_ADDR_TEMP_BIT) {
1342     addr &= UFO_ADDR_TEMP_MASK;
1343     if (addr + 1u >= ufoImageTempSize) {
1344       // accessing unallocated image area is segmentation fault
1345       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1346     }
1347     return *(const uint16_t *)((const uint8_t *)ufoImageTemp + addr);
1348   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1349     return ufoHandleLoadWord(addr, 0);
1350   } else {
1351     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1352   }
1353 }
1354
1355
1356 //==========================================================================
1357 //
1358 //  ufoImgGetU32
1359 //
1360 //  fast
1361 //
1362 //==========================================================================
1363 UFO_FORCE_INLINE uint32_t ufoImgGetU32 (uint32_t addr) {
1364   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1365     if (addr + 3u >= ufoImageSize) {
1366       // accessing unallocated image area is segmentation fault
1367       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1368     }
1369     return *(const uint32_t *)((const uint8_t *)ufoImage + addr);
1370   } else if (addr & UFO_ADDR_TEMP_BIT) {
1371     addr &= UFO_ADDR_TEMP_MASK;
1372     if (addr + 3u >= ufoImageTempSize) {
1373       // accessing unallocated image area is segmentation fault
1374       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1375     }
1376     return *(const uint32_t *)((const uint8_t *)ufoImageTemp + addr);
1377   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1378     return ufoHandleLoadCell(addr, 0);
1379   } else {
1380     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1381   }
1382 }
1383
1384 #else
1385
1386 //==========================================================================
1387 //
1388 //  ufoImgPutU8
1389 //
1390 //  general
1391 //
1392 //==========================================================================
1393 UFO_FORCE_INLINE void ufoImgPutU8 (uint32_t addr, const uint32_t value) {
1394   uint32_t *imgptr;
1395   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1396     if (addr >= ufoImageSize) {
1397       #ifdef UFO_HUGE_IMAGES
1398       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1399       #else
1400       ufoImgEnsureSize(addr);
1401       #endif
1402     }
1403     imgptr = &ufoImage[addr/4u];
1404   } else if (addr & UFO_ADDR_TEMP_BIT) {
1405     addr &= UFO_ADDR_TEMP_MASK;
1406     if (addr >= ufoImageTempSize) {
1407       #ifdef UFO_HUGE_IMAGES
1408       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1409       #else
1410       ufoImgEnsureTemp(addr);
1411       #endif
1412     }
1413     imgptr = &ufoImageTemp[addr/4u];
1414   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1415     ufoHandleStoreByte(addr, 0, value);
1416   } else {
1417     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1418   }
1419   const uint8_t val = (uint8_t)value;
1420   memcpy((uint8_t *)imgptr + (addr&3), &val, 1);
1421 }
1422
1423
1424 //==========================================================================
1425 //
1426 //  ufoImgPutU16
1427 //
1428 //  general
1429 //
1430 //==========================================================================
1431 UFO_FORCE_INLINE void ufoImgPutU16 (uint32_t addr, const uint32_t value) {
1432   ufoImgPutU8(addr, value&0xffU);
1433   ufoImgPutU8(addr + 1u, (value>>8)&0xffU);
1434 }
1435
1436
1437 //==========================================================================
1438 //
1439 //  ufoImgPutU32
1440 //
1441 //  general
1442 //
1443 //==========================================================================
1444 UFO_FORCE_INLINE void ufoImgPutU32 (uint32_t addr, const uint32_t value) {
1445   ufoImgPutU16(addr, value&0xffffU);
1446   ufoImgPutU16(addr + 2u, (value>>16)&0xffffU);
1447 }
1448
1449
1450 //==========================================================================
1451 //
1452 //  ufoImgGetU8
1453 //
1454 //  general
1455 //
1456 //==========================================================================
1457 UFO_FORCE_INLINE uint32_t ufoImgGetU8 (uint32_t addr) {
1458   uint32_t *imgptr;
1459   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1460     if (addr >= ufoImageSize) {
1461       // accessing unallocated image area is segmentation fault
1462       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1463     }
1464     imgptr = &ufoImage[addr/4u];
1465   } else if (addr & UFO_ADDR_TEMP_BIT) {
1466     addr &= UFO_ADDR_TEMP_MASK;
1467     if (addr >= ufoImageTempSize) return 0;
1468     imgptr = &ufoImageTemp[addr/4u];
1469   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1470     return ufoHandleLoadByte(addr, 0, value);
1471   } else {
1472     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1473   }
1474   uint8_t val;
1475   memcpy(&val, (uint8_t *)imgptr + (addr&3), 1);
1476   return (uint32_t)val;
1477 }
1478
1479
1480 //==========================================================================
1481 //
1482 //  ufoImgGetU16
1483 //
1484 //  general
1485 //
1486 //==========================================================================
1487 UFO_FORCE_INLINE uint32_t ufoImgGetU16 (uint32_t addr) {
1488   return ufoImgGetU8(addr) | (ufoImgGetU8(addr + 1u) << 8);
1489 }
1490
1491
1492 //==========================================================================
1493 //
1494 //  ufoImgGetU32
1495 //
1496 //  general
1497 //
1498 //==========================================================================
1499 UFO_FORCE_INLINE uint32_t ufoImgGetU32 (uint32_t addr) {
1500   return ufoImgGetU16(addr) | (ufoImgGetU16(addr + 2u) << 16);
1501 }
1502 #endif
1503
1504
1505 //==========================================================================
1506 //
1507 //  ufoEnsureDebugSize
1508 //
1509 //==========================================================================
1510 UFO_DISABLE_INLINE void ufoEnsureDebugSize (uint32_t sdelta) {
1511   ufo_assert(sdelta != 0);
1512   if (ufoDebugImageSize != 0) {
1513     if (ufoDebugImageUsed + sdelta >= 0x40000000U) ufoFatal("debug info too big");
1514     if (ufoDebugImageUsed + sdelta > ufoDebugImageSize) {
1515       // grow by 32KB, this should be more than enough
1516       const uint32_t newsz = ((ufoDebugImageUsed + sdelta) | 0x7fffU) + 1u;
1517       uint8_t *ndb = realloc(ufoDebugImage, newsz);
1518       if (ndb == NULL) ufoFatal("out of memory for debug info");
1519       ufoDebugImage = ndb;
1520       ufoDebugImageSize = newsz;
1521     }
1522   } else {
1523     // initial allocation: 32KB, quite a lot
1524     ufo_assert(ufoDebugImage == NULL);
1525     ufo_assert(ufoDebugImageUsed == 0);
1526     ufoDebugImageSize = 1024 * 32;
1527     ufoDebugImage = malloc(ufoDebugImageSize);
1528     if (ufoDebugImage == NULL) ufoFatal("out of memory for debug info");
1529   }
1530 }
1531
1532
1533 #define UFO_DBG_PUT_U4(val_)  do { \
1534   const uint32_t vv_ = (val_); \
1535   *((uint32_t *)(ufoDebugImage + ufoDebugImageUsed)) = vv_; \
1536   ufoDebugImageUsed += 4u; \
1537 } while (0)
1538
1539
1540 /*
1541   debug info header:
1542     dd lastFileInfoOfs
1543     ...first line info header...
1544   line info header (or reset):
1545     db 0   ; zero line delta
1546     dw followFileInfoSize  ; either it, or 0 if reused
1547     dd fileInfoOfs         ; present only if reused
1548   lines:
1549     dv lineDelta
1550     dv pcBytes
1551
1552   file info record:
1553     dd prevFileInfoOfs
1554     dd fileNameHash
1555     dd nameLen  ; without terminating 0
1556     ...name... (0-terminated)
1557
1558   we will never compare file names: length and hash should provide
1559   good enough unique identifier.
1560
1561 static uint8_t *ufoDebugImage = NULL;
1562 static uint32_t ufoDebugImageUsed = 0; // in bytes
1563 static uint32_t ufoDebugImageSize = 0; // in bytes
1564 static uint32_t ufoDebugFileNameHash = 0; // current file name hash
1565 static uint32_t ufoDebugFileNameLen = 0; // current file name length
1566 static uint32_t ufoDebugCurrDP = 0;
1567 */
1568
1569
1570 //==========================================================================
1571 //
1572 //  ufoSkipDebugVarInt
1573 //
1574 //==========================================================================
1575 static __attribute__((unused)) uint32_t ufoSkipDebugVarInt (uint32_t ofs) {
1576   uint8_t byte;
1577   do {
1578     if (ofs >= ufoDebugImageUsed) ufoFatal("invalid debug data");
1579     byte = ufoDebugImage[ofs]; ofs += 1u;
1580   } while (byte >= 0x80);
1581   return ofs;
1582 }
1583
1584
1585 //==========================================================================
1586 //
1587 //  ufoCalcDebugVarIntSize
1588 //
1589 //==========================================================================
1590 UFO_FORCE_INLINE uint8_t ufoCalcDebugVarIntSize (uint32_t v) {
1591   uint8_t count = 0;
1592   do {
1593     count += 1u;
1594     v >>= 7;
1595   } while (v != 0);
1596   return count;
1597 }
1598
1599
1600 //==========================================================================
1601 //
1602 //  ufoGetDebugVarInt
1603 //
1604 //==========================================================================
1605 static __attribute__((unused)) uint32_t ufoGetDebugVarInt (uint32_t ofs) {
1606   uint32_t v = 0;
1607   uint8_t shift = 0;
1608   uint8_t byte;
1609   do {
1610     if (ofs >= ufoDebugImageUsed) ufoFatal("invalid debug data");
1611     byte = ufoDebugImage[ofs];
1612     v |= (uint32_t)(byte & 0x7f) << shift;
1613     if (byte >= 0x80) {
1614       shift += 7;
1615       ofs += 1u;
1616     }
1617   } while (byte >= 0x80);
1618   return v;
1619 }
1620
1621
1622 //==========================================================================
1623 //
1624 //  ufoPutDebugVarInt
1625 //
1626 //==========================================================================
1627 UFO_FORCE_INLINE void ufoPutDebugVarInt (uint32_t v) {
1628   ufoEnsureDebugSize(5u); // maximum size
1629   do {
1630     if (v >= 0x80) {
1631       ufoDebugImage[ufoDebugImageUsed] = (uint8_t)(v | 0x80u);
1632     } else {
1633       ufoDebugImage[ufoDebugImageUsed] = (uint8_t)v;
1634     }
1635     ufoDebugImageUsed += 1;
1636     v >>= 7;
1637   } while (v != 0);
1638 }
1639
1640
1641 #ifdef UFO_DEBUG_DEBUG
1642 //==========================================================================
1643 //
1644 //  ufoDumpDebugInfo
1645 //
1646 //==========================================================================
1647 static void ufoDumpDebugImage (void) {
1648   #if 0
1649   uint32_t dbgpos = 4u; // first line header info
1650   uint32_t lastline = 0;
1651   uint32_t lastdp = 0;
1652   while (dbgpos < ufoDebugImageUsed) {
1653     if (ufoDebugImage[dbgpos] == 0) {
1654       // new file info
1655       dbgpos += 1u; // skip flag
1656       const uint32_t fhdrSize = *(const uint16_t *)(ufoDebugImage + dbgpos); dbgpos += 2u;
1657       lastdp = ufoGetDebugVarInt(dbgpos);
1658       dbgpos = ufoSkipDebugVarInt(dbgpos);
1659       if (fhdrSize == 0) {
1660         // reused
1661         const uint32_t infoOfs = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1662         fprintf(stderr, "*** OLD FILE: %s\n", (const char *)(ufoDebugImage + infoOfs + 3u * 4u));
1663         fprintf(stderr, "FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + infoOfs))[2]);
1664         fprintf(stderr, "FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + infoOfs))[1]);
1665       } else {
1666         // new
1667         fprintf(stderr, "*** NEW FILE: %s\n", (const char *)(ufoDebugImage + dbgpos + 3u * 4u));
1668         fprintf(stderr, "FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + dbgpos))[2]);
1669         fprintf(stderr, "FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + dbgpos))[1]);
1670       }
1671       dbgpos += fhdrSize;
1672       fprintf(stderr, "LINES-OFS: 0x%08x (hsz: %u -- 0x%08x)\n", dbgpos, fhdrSize, fhdrSize);
1673       lastline = ~(uint32_t)0;
1674     } else {
1675       const uint32_t ln = ufoGetDebugVarInt(dbgpos);
1676       dbgpos = ufoSkipDebugVarInt(dbgpos);
1677       ufo_assert(ln != 0);
1678       lastline += ln;
1679       const uint32_t edp = ufoGetDebugVarInt(dbgpos);
1680       dbgpos = ufoSkipDebugVarInt(dbgpos);
1681       lastdp += edp;
1682       fprintf(stderr, "  line %6u: edp=%u\n", lastline, lastdp);
1683     }
1684   }
1685   #endif
1686 }
1687 #endif
1688
1689
1690 //==========================================================================
1691 //
1692 //  ufoRecordDebugCheckFile
1693 //
1694 //  if we moved to the new file:
1695 //    put "line info header"
1696 //    put new file info (or reuse old)
1697 //
1698 //==========================================================================
1699 UFO_FORCE_INLINE void ufoRecordDebugCheckFile (void) {
1700   if (ufoDebugImageUsed == 0 ||
1701       ufoDebugFileNameLen != ufoInFileNameLen ||
1702       ufoDebugFileNameHash != ufoInFileNameHash)
1703   {
1704     // new file record (or reuse old one)
1705     const int initial = (ufoDebugImageUsed == 0);
1706     uint32_t fileRec = 0;
1707     // try to find and old one
1708     if (!initial) {
1709       fileRec = *(const uint32_t *)ufoDebugImage;
1710       #if 0
1711       fprintf(stderr, "*** NEW-FILE(%u): 0x%08x: <%s> (frec=0x%08x)\n", ufoInFileNameLen,
1712               ufoInFileNameHash, ufoInFileName, fileRec);
1713       #endif
1714       while (fileRec != 0 &&
1715              (ufoInFileNameLen != ((const uint32_t *)(ufoDebugImage + fileRec))[1] ||
1716               ufoInFileNameHash != ((const uint32_t *)(ufoDebugImage + fileRec))[2]))
1717       {
1718         #if 0
1719         fprintf(stderr, "*** FRCHECK: 0x%08x\n", fileRec);
1720         fprintf(stderr, "  FILE NAME: %s\n", (const char *)(ufoDebugImage + fileRec + 3u * 4u));
1721         fprintf(stderr, "  FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + fileRec))[2]);
1722         fprintf(stderr, "  FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + fileRec))[1]);
1723         fprintf(stderr, "  FILE PREV: 0x%08x\n", *(const uint32_t *)(ufoDebugImage + fileRec));
1724         #endif
1725         fileRec = *(const uint32_t *)(ufoDebugImage + fileRec);
1726       }
1727       #if 0
1728       fprintf(stderr, "*** FRCHECK-DONE: 0x%08x\n", fileRec);
1729       if (fileRec != 0) {
1730         fprintf(stderr, "    FILE NAME: %s\n", (const char *)(ufoDebugImage + fileRec + 3u * 4u));
1731         fprintf(stderr, "    FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + fileRec))[2]);
1732         fprintf(stderr, "    FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + fileRec))[1]);
1733         fprintf(stderr, "    FILE PREV: 0x%08x\n", *(const uint32_t *)(ufoDebugImage + fileRec));
1734       }
1735       #endif
1736     } else {
1737       ufoEnsureDebugSize(8u);
1738       *(uint32_t *)ufoDebugImage = 0;
1739     }
1740     // write "line info header"
1741     if (fileRec != 0) {
1742       ufoEnsureDebugSize(32u);
1743       ufoDebugImage[ufoDebugImageUsed] = 0; ufoDebugImageUsed += 1u; // header flag (0 delta)
1744       // file record size: 0 (reused)
1745       *((uint16_t *)(ufoDebugImage + ufoDebugImageUsed)) = 0; ufoDebugImageUsed += 2u;
1746       // put last DP
1747       ufoPutDebugVarInt(ufoDebugCurrDP);
1748       // file info offset
1749       UFO_DBG_PUT_U4(fileRec);
1750     } else {
1751       // name, trailing 0 byte, 3 dword fields
1752       const uint32_t finfoSize = ufoInFileNameLen + 1u + 3u * 4u;
1753       ufo_assert(finfoSize < 65536u);
1754       ufoEnsureDebugSize(finfoSize + 32u);
1755       if (initial) {
1756         *(uint32_t *)ufoDebugImage = 0;
1757         ufoDebugImageUsed = 4;
1758       }
1759       ufoDebugImage[ufoDebugImageUsed] = 0; ufoDebugImageUsed += 1u; // header flag (0 delta)
1760       // file record size
1761       *((uint16_t *)(ufoDebugImage + ufoDebugImageUsed)) = (uint16_t)finfoSize; ufoDebugImageUsed += 2u;
1762       // put last DP
1763       ufoPutDebugVarInt(ufoDebugCurrDP);
1764       // file record follows
1765       // fix file info offsets
1766       uint32_t lastOfs = *(const uint32_t *)ufoDebugImage;
1767       *(uint32_t *)ufoDebugImage = ufoDebugImageUsed;
1768       UFO_DBG_PUT_U4(lastOfs);
1769       // save file info hash
1770       UFO_DBG_PUT_U4(ufoInFileNameHash);
1771       // save file info length
1772       UFO_DBG_PUT_U4(ufoInFileNameLen);
1773       // save file name
1774       if (ufoInFileNameLen != 0) {
1775         memcpy(ufoDebugImage + ufoDebugImageUsed, ufoInFileName, ufoInFileNameLen + 1u);
1776         ufoDebugImageUsed += ufoInFileNameLen + 1u;
1777       } else {
1778         ufoDebugImage[ufoDebugImageUsed] = 0; ufoDebugImageUsed += 1u;
1779       }
1780     }
1781     ufoDebugFileNameLen = ufoInFileNameLen;
1782     ufoDebugFileNameHash = ufoInFileNameHash;
1783     ufoDebugLastLine = ~(uint32_t)0;
1784     ufoDebugLastLinePCOfs = 0;
1785     ufoDebugLastLineDP = ufoDebugCurrDP;
1786   }
1787 }
1788
1789
1790 //==========================================================================
1791 //
1792 //  ufoRecordDebugRecordLine
1793 //
1794 //==========================================================================
1795 UFO_FORCE_INLINE void ufoRecordDebugRecordLine (uint32_t line, uint32_t newhere) {
1796   if (line == ufoDebugLastLine) {
1797     ufo_assert(ufoDebugLastLinePCOfs != 0);
1798     ufoDebugImageUsed = ufoDebugLastLinePCOfs;
1799   } else {
1800     #if 0
1801     fprintf(stderr, "FL-NEW-LINE(0x%08x): <%s>; new line: %u (old: %u)\n",
1802             ufoDebugImageUsed,
1803             ufoInFileName, line, ufoDebugLastLine);
1804     #endif
1805     ufoPutDebugVarInt(line - ufoDebugLastLine);
1806     ufoDebugLastLinePCOfs = ufoDebugImageUsed;
1807     ufoDebugLastLine = line;
1808     ufoDebugLastLineDP = ufoDebugCurrDP;
1809   }
1810   ufoPutDebugVarInt(newhere - ufoDebugLastLineDP);
1811   ufoDebugCurrDP = newhere;
1812 }
1813
1814
1815 //==========================================================================
1816 //
1817 //  ufoRecordDebug
1818 //
1819 //==========================================================================
1820 UFO_DISABLE_INLINE void ufoRecordDebug (uint32_t newhere) {
1821   if (newhere > ufoDebugCurrDP) {
1822     uint32_t ln = (uint32_t)ufoInFileLine;
1823     if (ln == ~(uint32_t)0) ln = 0;
1824     #if 0
1825     fprintf(stderr, "FL: <%s>; line: %d\n", ufoInFileName, ufoInFileLine);
1826     #endif
1827     ufoRecordDebugCheckFile();
1828     ufoRecordDebugRecordLine(ln, newhere);
1829   }
1830 }
1831
1832
1833 //==========================================================================
1834 //
1835 //  ufoGetWordEndAddrYFA
1836 //
1837 //==========================================================================
1838 static uint32_t ufoGetWordEndAddrYFA (uint32_t yfa) {
1839   if (yfa > 8u) {
1840     const uint32_t oyfa = yfa;
1841     yfa = ufoImgGetU32(yfa); // YFA points to next YFA
1842     if (yfa == 0) {
1843       // last defined word
1844       if ((oyfa & UFO_ADDR_TEMP_BIT) == 0) {
1845         yfa = ufoImgGetU32(ufoAddrDP);
1846       } else {
1847         yfa = ufoImgGetU32(ufoAddrDPTemp);
1848       }
1849     } else {
1850       yfa = UFO_YFA_TO_WST(yfa);
1851     }
1852   } else {
1853     yfa = 0;
1854   }
1855   return yfa;
1856 }
1857
1858
1859 //==========================================================================
1860 //
1861 //  ufoGetWordEndAddr
1862 //
1863 //==========================================================================
1864 static uint32_t ufoGetWordEndAddr (const uint32_t cfa) {
1865   if (cfa != 0) {
1866     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
1867     const uint32_t yfa = UFO_LFA_TO_YFA(lfa);
1868     return ufoGetWordEndAddrYFA(yfa);
1869   } else {
1870     return 0;
1871   }
1872 }
1873
1874
1875 //==========================================================================
1876 //
1877 //  ufoFindWordForIP
1878 //
1879 //  return NFA or 0
1880 //
1881 //  WARNING: this is SLOW!
1882 //
1883 //==========================================================================
1884 static uint32_t ufoFindWordForIP (const uint32_t ip) {
1885   uint32_t res = 0;
1886   if (ip != 0) {
1887     //fprintf(stderr, "ufoFindWordForIP:000: ip=0x%08x\n", ip);
1888     // iterate over all words
1889     uint32_t xfa = ufoImgGetU32(ufoAddrLastXFA);
1890     //fprintf(stderr, "ufoFindWordForIP:001: xfa=0x%08x\n", xfa);
1891     if (xfa != 0) {
1892       while (res == 0 && xfa != 0) {
1893         const uint32_t yfa = UFO_XFA_TO_YFA(xfa);
1894         const uint32_t wst = UFO_YFA_TO_WST(yfa);
1895         //fprintf(stderr, "ufoFindWordForIP:002:   yfa=0x%08x; wst=0x%08x\n", yfa, wst);
1896         const uint32_t wend = ufoGetWordEndAddrYFA(yfa);
1897         if (ip >= wst && ip < wend) {
1898           res = UFO_YFA_TO_NFA(yfa);
1899         } else {
1900           xfa = ufoImgGetU32(xfa);
1901         }
1902       }
1903     }
1904   }
1905   return res;
1906 }
1907
1908
1909 //==========================================================================
1910 //
1911 //  ufoFindFileForIP
1912 //
1913 //  return file name or `NULL`
1914 //
1915 //  WARNING: this is SLOW!
1916 //
1917 //==========================================================================
1918 static const char *ufoFindFileForIP (uint32_t ip, uint32_t *line,
1919                                      uint32_t *nlen, uint32_t *nhash)
1920 {
1921   if (ip != 0 && ufoDebugImageUsed != 0) {
1922     const char *filename = NULL;
1923     uint32_t dbgpos = 4u; // first line header info
1924     uint32_t lastline = 0;
1925     uint32_t lastdp = 0;
1926     uint32_t namelen = 0;
1927     uint32_t namehash = 0;
1928     while (dbgpos < ufoDebugImageUsed) {
1929       if (ufoDebugImage[dbgpos] == 0) {
1930         // new file info
1931         dbgpos += 1u; // skip flag
1932         const uint32_t fhdrSize = *(const uint16_t *)(ufoDebugImage + dbgpos); dbgpos += 2u;
1933         lastdp = ufoGetDebugVarInt(dbgpos);
1934         dbgpos = ufoSkipDebugVarInt(dbgpos);
1935         uint32_t infoOfs;
1936         if (fhdrSize == 0) {
1937           // reused
1938           infoOfs = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1939         } else {
1940           // new
1941           infoOfs = dbgpos;
1942         }
1943         filename = (const char *)(ufoDebugImage + infoOfs + 3u * 4u);
1944         namelen = ((const uint32_t *)(ufoDebugImage + infoOfs))[2];
1945         namehash = ((const uint32_t *)(ufoDebugImage + infoOfs))[1];
1946         if (filename[0] == 0) filename = NULL;
1947         dbgpos += fhdrSize;
1948         lastline = ~(uint32_t)0;
1949       } else {
1950         const uint32_t ln = ufoGetDebugVarInt(dbgpos);
1951         dbgpos = ufoSkipDebugVarInt(dbgpos);
1952         ufo_assert(ln != 0);
1953         lastline += ln;
1954         const uint32_t edp = ufoGetDebugVarInt(dbgpos);
1955         dbgpos = ufoSkipDebugVarInt(dbgpos);
1956         if (ip >= lastdp && ip < lastdp + edp) {
1957           if (line) *line = lastline;
1958           if (nlen) *nlen = namelen;
1959           if (nhash) *nhash = namehash;
1960           return filename;
1961         }
1962         lastdp += edp;
1963       }
1964     }
1965   }
1966   if (line) *line = 0;
1967   if (nlen) *nlen = 0;
1968   if (nhash) *nlen = 0;
1969   return NULL;
1970 }
1971
1972
1973 //==========================================================================
1974 //
1975 //  ufoBumpDP
1976 //
1977 //==========================================================================
1978 UFO_FORCE_INLINE void ufoBumpDP (uint32_t delta) {
1979   const uint32_t dpa = ufoImgGetU32(ufoAddrHereDP);
1980   uint32_t dp = ufoImgGetU32(dpa);
1981   if ((dp & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(dp + delta);
1982   dp += delta;
1983   ufoImgPutU32(dpa, dp);
1984 }
1985
1986
1987 //==========================================================================
1988 //
1989 //  ufoImgEmitU8
1990 //
1991 //==========================================================================
1992 UFO_FORCE_INLINE void ufoImgEmitU8 (uint32_t value) {
1993   ufoImgPutU8(UFO_GET_DP(), value);
1994   ufoBumpDP(1);
1995 }
1996
1997
1998 //==========================================================================
1999 //
2000 //  ufoImgEmitU16
2001 //
2002 //==========================================================================
2003 UFO_FORCE_INLINE void ufoImgEmitU16 (uint32_t value) {
2004   ufoImgPutU16(UFO_GET_DP(), value);
2005   ufoBumpDP(2);
2006 }
2007
2008
2009 //==========================================================================
2010 //
2011 //  ufoImgEmitU32
2012 //
2013 //==========================================================================
2014 UFO_FORCE_INLINE void ufoImgEmitU32 (uint32_t value) {
2015   ufoImgPutU32(UFO_GET_DP(), value);
2016   ufoBumpDP(4);
2017 }
2018
2019
2020 //==========================================================================
2021 //
2022 //  ufoImgEmitCFA
2023 //
2024 //==========================================================================
2025 UFO_FORCE_INLINE void ufoImgEmitCFA (uint32_t cfa) {
2026   const uint32_t addr = UFO_GET_DP();
2027   ufoImgPutU32(addr, cfa);
2028   ufoImgPutU32(addr + 4u, 0);
2029   ufoBumpDP(8);
2030 }
2031
2032
2033 #ifdef UFO_FAST_MEM_ACCESS
2034
2035 //==========================================================================
2036 //
2037 //  ufoImgEmitU32_NoInline
2038 //
2039 //  false
2040 //
2041 //==========================================================================
2042 UFO_FORCE_INLINE void ufoImgEmitU32_NoInline (uint32_t value) {
2043   ufoImgPutU32(UFO_GET_DP(), value);
2044   ufoBumpDP(4);
2045 }
2046
2047 #else
2048
2049 //==========================================================================
2050 //
2051 //  ufoImgEmitU32_NoInline
2052 //
2053 //  general
2054 //
2055 //==========================================================================
2056 UFO_DISABLE_INLINE void ufoImgEmitU32_NoInline (uint32_t value) {
2057   ufoImgPutU32(UFO_GET_DP(), value);
2058   ufoBumpDP(4);
2059 }
2060
2061 #endif
2062
2063
2064 //==========================================================================
2065 //
2066 //  ufoImgEmitAlign
2067 //
2068 //==========================================================================
2069 UFO_FORCE_INLINE void ufoImgEmitAlign (void) {
2070   while ((UFO_GET_DP() & 3) != 0) ufoImgEmitU8(0);
2071 }
2072
2073
2074 //==========================================================================
2075 //
2076 //  ufoResetTib
2077 //
2078 //==========================================================================
2079 UFO_FORCE_INLINE void ufoResetTib (void) {
2080   uint32_t defTIB = ufoImgGetU32(ufoAddrDefTIB);
2081   //fprintf(stderr, "ufoResetTib(%p): defTIB=0x%08x\n", ufoCurrState, defTIB);
2082   if (defTIB == 0) {
2083     // create new TIB handle
2084     UfoHandle *tibh = ufoAllocHandle(0x69a029a6); // arbitrary number
2085     defTIB = tibh->ufoHandle;
2086     ufoImgPutU32(ufoAddrDefTIB, defTIB);
2087   }
2088   if ((defTIB & UFO_ADDR_HANDLE_BIT) != 0) {
2089     UfoHandle *hh = ufoGetHandle(defTIB);
2090     if (hh == NULL) ufoFatal("default TIB is not allocated");
2091     if (hh->size == 0) {
2092       ufo_assert(hh->data == NULL);
2093       hh->data = calloc(1, UFO_ADDR_HANDLE_OFS_MASK + 1);
2094       if (hh->data == NULL) ufoFatal("out of memory for default TIB");
2095       hh->size = UFO_ADDR_HANDLE_OFS_MASK + 1;
2096     }
2097   }
2098   const uint32_t oldA = ufoRegA;
2099   ufoImgPutU32(ufoAddrTIBx, defTIB);
2100   ufoImgPutU32(ufoAddrINx, 0);
2101   ufoRegA = defTIB;
2102   ufoPush(0); // value
2103   ufoPush(0); // offset
2104   UFCALL(CPOKE_REGA_IDX);
2105   ufoRegA = oldA;
2106 }
2107
2108
2109 //==========================================================================
2110 //
2111 //  ufoTibEnsureSize
2112 //
2113 //==========================================================================
2114 UFO_DISABLE_INLINE void ufoTibEnsureSize (uint32_t size) {
2115   if (size > 1024u * 1024u * 256u) ufoFatal("TIB size too big");
2116   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
2117   //fprintf(stderr, "ufoTibEnsureSize: TIB=0x%08x; size=%u\n", tib, size);
2118   if ((tib & UFO_ADDR_HANDLE_BIT) != 0) {
2119     UfoHandle *hh = ufoGetHandle(tib);
2120     if (hh == NULL) {
2121       ufoFatal("cannot resize TIB, TIB is not a handle");
2122     }
2123     if (hh->size < size) {
2124       const uint32_t newsz = (size | 0xfffU) + 1u;
2125       uint8_t *nx = realloc(hh->data, newsz);
2126       if (nx == NULL) ufoFatal("out of memory for restored TIB");
2127       hh->data = nx;
2128       hh->size = newsz;
2129     }
2130   }
2131   #if 0
2132   else {
2133     ufoFatal("cannot resize TIB, TIB is not a handle (0x%08x)", tib);
2134   }
2135   #endif
2136 }
2137
2138
2139 //==========================================================================
2140 //
2141 //  ufoTibGetSize
2142 //
2143 //==========================================================================
2144 /*
2145 UFO_DISABLE_INLINE uint32_t ufoTibGetSize (void) {
2146   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
2147   if ((tib & UFO_ADDR_HANDLE_BIT) == 0) {
2148     ufoFatal("cannot query TIB, TIB is not a handle");
2149   }
2150   UfoHandle *hh = ufoGetHandle(tib);
2151   if (hh == NULL) {
2152     ufoFatal("cannot query TIB, TIB is not a handle");
2153   }
2154   return hh->size;
2155 }
2156 */
2157
2158
2159 //==========================================================================
2160 //
2161 //  ufoTibPeekCh
2162 //
2163 //==========================================================================
2164 UFO_FORCE_INLINE uint8_t ufoTibPeekCh (void) {
2165   return (uint8_t)ufoImgGetU8(ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx));
2166 }
2167
2168
2169 //==========================================================================
2170 //
2171 //  ufoTibPeekChOfs
2172 //
2173 //==========================================================================
2174 UFO_FORCE_INLINE uint8_t ufoTibPeekChOfs (uint32_t ofs) {
2175   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
2176   if (ofs <= UFO_ADDR_HANDLE_OFS_MASK || (tib & UFO_ADDR_HANDLE_BIT) == 0) {
2177     return (uint8_t)ufoImgGetU8(tib + ufoImgGetU32(ufoAddrINx) + ofs);
2178   } else {
2179     return 0;
2180   }
2181 }
2182
2183
2184 //==========================================================================
2185 //
2186 //  ufoTibPokeChOfs
2187 //
2188 //==========================================================================
2189 UFO_DISABLE_INLINE void ufoTibPokeChOfs (uint8_t ch, uint32_t ofs) {
2190   const uint32_t oldA = ufoRegA;
2191   ufoRegA = ufoImgGetU32(ufoAddrTIBx);
2192   ufoPush(ch);
2193   ufoPush(ufoImgGetU32(ufoAddrINx) + ofs);
2194   UFCALL(CPOKE_REGA_IDX);
2195   ufoRegA = oldA;
2196 }
2197
2198
2199 //==========================================================================
2200 //
2201 //  ufoTibGetCh
2202 //
2203 //==========================================================================
2204 UFO_FORCE_INLINE uint8_t ufoTibGetCh (void) {
2205   const uint8_t ch = ufoTibPeekCh();
2206   if (ch) ufoImgPutU32(ufoAddrINx, ufoImgGetU32(ufoAddrINx) + 1u);
2207   return ch;
2208 }
2209
2210
2211 //==========================================================================
2212 //
2213 //  ufoTibSkipCh
2214 //
2215 //==========================================================================
2216 UFO_FORCE_INLINE void ufoTibSkipCh (void) {
2217   (void)ufoTibGetCh();
2218 }
2219
2220
2221 // ////////////////////////////////////////////////////////////////////////// //
2222 // native CFA implementations
2223 //
2224
2225 //==========================================================================
2226 //
2227 //  ufoDoForth
2228 //
2229 //==========================================================================
2230 static void ufoDoForth (uint32_t pfa) {
2231   ufoRPush(ufoIP);
2232   ufoIP = pfa;
2233 }
2234
2235
2236 //==========================================================================
2237 //
2238 //  ufoDoVariable
2239 //
2240 //==========================================================================
2241 static void ufoDoVariable (uint32_t pfa) {
2242   ufoPush(pfa);
2243 }
2244
2245
2246 //==========================================================================
2247 //
2248 //  ufoDoUserVariable
2249 //
2250 //==========================================================================
2251 static void ufoDoUserVariable (uint32_t pfa) {
2252   ufoPush(ufoImgGetU32(pfa));
2253 }
2254
2255
2256 //==========================================================================
2257 //
2258 //  ufoDoValue
2259 //
2260 //==========================================================================
2261 static void ufoDoValue (uint32_t pfa) {
2262   ufoPush(ufoImgGetU32(pfa));
2263 }
2264
2265
2266 //==========================================================================
2267 //
2268 //  ufoDoConst
2269 //
2270 //==========================================================================
2271 static void ufoDoConst (uint32_t pfa) {
2272   ufoPush(ufoImgGetU32(pfa));
2273 }
2274
2275
2276 //==========================================================================
2277 //
2278 //  ufoDoDefer
2279 //
2280 //==========================================================================
2281 static void ufoDoDefer (uint32_t pfa) {
2282   pfa = ufoImgGetU32(pfa);
2283   UFO_EXEC_CFA(pfa);
2284 }
2285
2286
2287 //==========================================================================
2288 //
2289 //  ufoDoDoes
2290 //
2291 //==========================================================================
2292 static void ufoDoDoes (uint32_t pfa) {
2293   ufoPush(pfa);
2294   ufoRPush(ufoIP);
2295   ufoIP = ufoImgGetU32(UFO_PFA_TO_DOES_CFA(pfa));
2296 }
2297
2298
2299 //==========================================================================
2300 //
2301 //  ufoDoRedirect
2302 //
2303 //==========================================================================
2304 static void ufoDoRedirect (uint32_t pfa) {
2305   pfa = ufoImgGetU32(UFO_PFA_TO_DOES_CFA(pfa));
2306   UFO_EXEC_CFA(pfa);
2307 }
2308
2309
2310 //==========================================================================
2311 //
2312 //  ufoDoVoc
2313 //
2314 //==========================================================================
2315 static void ufoDoVoc (uint32_t pfa) {
2316   ufoImgPutU32(ufoAddrContext, ufoImgGetU32(pfa));
2317 }
2318
2319
2320 //==========================================================================
2321 //
2322 //  ufoDoCreate
2323 //
2324 //==========================================================================
2325 static void ufoDoCreate (uint32_t pfa) {
2326   ufoPush(pfa);
2327 }
2328
2329
2330 //==========================================================================
2331 //
2332 //  ufoPushInFile
2333 //
2334 //  this also increments last used file id
2335 //
2336 //==========================================================================
2337 static void ufoPushInFile (void) {
2338   if (ufoFileStackPos >= UFO_MAX_NESTED_INCLUDES) ufoFatal("too many includes");
2339   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
2340   stk->fl = ufoInFile;
2341   stk->fname = ufoInFileName;
2342   stk->fline = ufoInFileLine;
2343   stk->id = ufoFileId;
2344   stk->incpath = (ufoLastIncPath ? strdup(ufoLastIncPath) : NULL);
2345   stk->sysincpath = (ufoLastSysIncPath ? strdup(ufoLastSysIncPath) : NULL);
2346   ufoFileStackPos += 1;
2347   ufoInFile = NULL;
2348   ufoInFileName = NULL; ufoInFileNameLen = 0; ufoInFileNameHash = 0;
2349   ufoInFileLine = 0;
2350   ufoLastUsedFileId += 1;
2351   ufo_assert(ufoLastUsedFileId != 0); // just in case ;-)
2352   //ufoLastIncPath = NULL;
2353 }
2354
2355
2356 //==========================================================================
2357 //
2358 //  ufoWipeIncludeStack
2359 //
2360 //==========================================================================
2361 static void ufoWipeIncludeStack (void) {
2362   if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
2363   if (ufoInFile) { fclose(ufoInFile); ufoInFile = NULL; }
2364   if (ufoLastIncPath) { free(ufoLastIncPath); ufoLastIncPath = NULL; }
2365   if (ufoLastSysIncPath) { free(ufoLastSysIncPath); ufoLastSysIncPath = NULL; }
2366   while (ufoFileStackPos != 0) {
2367     ufoFileStackPos -= 1;
2368     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
2369     if (stk->fl) fclose(stk->fl);
2370     if (stk->fname) free(stk->fname);
2371     if (stk->incpath) free(stk->incpath);
2372   }
2373 }
2374
2375
2376 //==========================================================================
2377 //
2378 //  ufoPopInFile
2379 //
2380 //==========================================================================
2381 static void ufoPopInFile (void) {
2382   if (ufoFileStackPos == 0) ufoFatal("trying to pop include from empty stack");
2383   if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
2384   if (ufoInFile) { fclose(ufoInFile); ufoInFile = NULL; }
2385   if (ufoLastIncPath) { free(ufoLastIncPath); ufoLastIncPath = NULL; }
2386   if (ufoLastSysIncPath) { free(ufoLastSysIncPath); ufoLastSysIncPath = NULL; }
2387   ufoFileStackPos -= 1;
2388   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
2389   ufoInFile = stk->fl;
2390   ufoSetInFileNameReuse(stk->fname);
2391   ufoInFileLine = stk->fline;
2392   ufoLastIncPath = stk->incpath;
2393   ufoLastSysIncPath = stk->sysincpath;
2394   ufoFileId = stk->id;
2395   ufoResetTib();
2396   #ifdef UFO_DEBUG_INCLUDE
2397   if (ufoInFileName == NULL) {
2398     fprintf(stderr, "INC-POP: no more files.\n");
2399   } else {
2400     fprintf(stderr, "INC-POP: fname: %s\n", ufoInFileName);
2401   }
2402   #endif
2403 }
2404
2405
2406 //==========================================================================
2407 //
2408 //  ufoDeinit
2409 //
2410 //==========================================================================
2411 void ufoDeinit (void) {
2412   #ifdef UFO_DEBUG_WRITE_MAIN_IMAGE
2413   {
2414     FILE *fo = fopen("zufo_main.img", "w");
2415     const uint32_t dpMain = ufoImgGetU32(ufoAddrDP);
2416     fwrite(ufoImage, dpMain, 1, fo);
2417     fclose(fo);
2418   }
2419   #endif
2420
2421   #ifdef UFO_DEBUG_WRITE_DEBUG_IMAGE
2422   {
2423     FILE *fo = fopen("zufo_debug.img", "w");
2424     fwrite(ufoDebugImage, ufoDebugImageUsed, 1, fo);
2425     fclose(fo);
2426   }
2427   #endif
2428
2429   #ifdef UFO_DEBUG_DEBUG
2430   {
2431     const uint32_t dpMain = ufoImgGetU32(ufoAddrDP);
2432     fprintf(stderr, "UFO: image used: %u; size: %u\n", dpMain, ufoImageSize);
2433     fprintf(stderr, "UFO: debug image used: %u; size: %u\n", ufoDebugImageUsed, ufoDebugImageSize);
2434     ufoDumpDebugImage();
2435   }
2436   #endif
2437
2438   // free all states
2439   #ifdef UFO_MTASK_ALLOWED
2440   ufoCurrState = NULL;
2441   ufoYieldedState = NULL;
2442   ufoDebuggerState = NULL;
2443   for (uint32_t fidx = 0; fidx < (uint32_t)(UFO_MAX_STATES/32); fidx += 1u) {
2444     uint32_t bmp = ufoStateUsedBitmap[fidx];
2445     if (bmp != 0) {
2446       uint32_t stid = fidx * 32u;
2447       while (bmp != 0) {
2448         if ((bmp & 0x01) != 0) ufoFreeState(ufoStateMap[stid]);
2449         stid += 1u; bmp >>= 1;
2450       }
2451     }
2452   }
2453   #endif
2454
2455   free(ufoDebugImage);
2456   ufoDebugImage = NULL;
2457   ufoDebugImageUsed = 0;
2458   ufoDebugImageSize = 0;
2459   ufoDebugFileNameHash = 0;
2460   ufoDebugFileNameLen = 0;
2461   ufoDebugLastLine = 0;
2462   ufoDebugLastLinePCOfs = 0;
2463   ufoDebugLastLineDP = 0;
2464   ufoDebugCurrDP = 0;
2465
2466   ufoInBacktrace = 0;
2467   ufoClearCondDefines();
2468   ufoWipeIncludeStack();
2469
2470   // release all includes
2471   ufoInFile = NULL;
2472   if (ufoInFileName) free(ufoInFileName);
2473   if (ufoLastIncPath) free(ufoLastIncPath);
2474   if (ufoLastSysIncPath) free(ufoLastSysIncPath);
2475   ufoInFileName = NULL; ufoLastIncPath = NULL; ufoLastSysIncPath = NULL;
2476   ufoInFileNameHash = 0; ufoInFileNameLen = 0;
2477   ufoInFileLine = 0;
2478
2479   //free(ufoForthCFAs);
2480   //ufoForthCFAs = NULL;
2481   ufoCFAsUsed = 0;
2482
2483   #ifndef UFO_HUGE_IMAGES
2484   free(ufoImage);
2485   ufoImage = NULL;
2486   ufoImageSize = 0;
2487   #endif
2488
2489   ufoMode = UFO_MODE_NATIVE;
2490   ufoForthVocId = 0; ufoCompilerVocId = 0;
2491   #ifdef UFO_MTASK_ALLOWED
2492   ufoSingleStep = 0;
2493   #endif
2494
2495   // free all handles
2496   for (uint32_t f = 0; f < ufoHandlesUsed; f += 1) {
2497     UfoHandle *hh = ufoHandles[f];
2498     if (hh != NULL) {
2499       if (hh->data != NULL) free(hh->data);
2500       free(hh);
2501     }
2502   }
2503   if (ufoHandles != NULL) free(ufoHandles);
2504   ufoHandles = NULL; ufoHandlesUsed = 0; ufoHandlesAlloted = 0;
2505   ufoHandleFreeList = NULL;
2506
2507   ufoLastEmitWasCR = 1;
2508
2509   ufoClearCondDefines();
2510 }
2511
2512
2513 //==========================================================================
2514 //
2515 //  ufoDumpWordHeader
2516 //
2517 //==========================================================================
2518 __attribute__((unused)) static void ufoDumpWordHeader (const uint32_t lfa) {
2519   fprintf(stderr, "=== WORD: LFA: 0x%08x ===\n", lfa);
2520   if (lfa != 0) {
2521     fprintf(stderr, "  (XFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_XFA(lfa)));
2522     fprintf(stderr, "  (YFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_YFA(lfa)));
2523     fprintf(stderr, "  (BFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_BFA(lfa)));
2524     fprintf(stderr, "  (LFA): 0x%08x\n", ufoImgGetU32(lfa));
2525     fprintf(stderr, "  (NHH): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)));
2526     const uint32_t cfa = UFO_LFA_TO_CFA(lfa);
2527     fprintf(stderr, "    CFA: 0x%08x\n", cfa);
2528     fprintf(stderr, "    PFA: 0x%08x\n", UFO_CFA_TO_PFA(cfa));
2529     fprintf(stderr, "  (CFA): 0x%08x\n", ufoImgGetU32(cfa));
2530     const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
2531     const uint32_t nlen = ufoImgGetU8(nfa);
2532     fprintf(stderr, "    NFA: 0x%08x  (nlen: %u)\n", nfa, nlen);
2533     const uint32_t flags = ufoImgGetU32(nfa);
2534     fprintf(stderr, "  FLAGS: 0x%08x\n", flags);
2535     if ((flags & 0xffff0000U) != 0) {
2536       fprintf(stderr, "  FLAGS:");
2537       if (flags & UFW_FLAG_IMMEDIATE) fprintf(stderr, " IMM");
2538       if (flags & UFW_FLAG_SMUDGE) fprintf(stderr, " SMUDGE");
2539       if (flags & UFW_FLAG_NORETURN) fprintf(stderr, " NORET");
2540       if (flags & UFW_FLAG_HIDDEN) fprintf(stderr, " HIDDEN");
2541       if (flags & UFW_FLAG_CBLOCK) fprintf(stderr, " CBLOCK");
2542       if (flags & UFW_FLAG_VOCAB) fprintf(stderr, " VOCAB");
2543       if (flags & UFW_FLAG_SCOLON) fprintf(stderr, " SCOLON");
2544       if (flags & UFW_FLAG_PROTECTED) fprintf(stderr, " PROTECTED");
2545       if (flags & UFW_WARG_CONDBRANCH) fprintf(stderr, " CONDBRANCH");
2546       if (flags & UFW_FLAG_MAYRETURN) fprintf(stderr, " MAYRETURN");
2547       fputc('\n', stderr);
2548     }
2549     if ((flags & 0xff00U) != 0) {
2550       fprintf(stderr, "   ARGS: ");
2551       switch (flags & UFW_WARG_MASK) {
2552         case UFW_WARG_NONE: fprintf(stderr, "NONE"); break;
2553         case UFW_WARG_BRANCH: fprintf(stderr, "BRANCH"); break;
2554         case UFW_WARG_LIT: fprintf(stderr, "LIT"); break;
2555         case UFW_WARG_C4STRZ: fprintf(stderr, "C4STRZ"); break;
2556         case UFW_WARG_CFA: fprintf(stderr, "CFA"); break;
2557         case UFW_WARG_CBLOCK: fprintf(stderr, "CBLOCK"); break;
2558         case UFW_WARG_VOCID: fprintf(stderr, "VOCID"); break;
2559         case UFW_WARG_C1STRZ: fprintf(stderr, "C1STRZ"); break;
2560         case UFW_WARG_DATASKIP: fprintf(stderr, "DATA"); break;
2561         case UFW_WARG_PFA: fprintf(stderr, "PFA"); break;
2562         default: fprintf(stderr, "wtf?!"); break;
2563       }
2564       fputc('\n', stderr);
2565     }
2566     fprintf(stderr, "  BACKLEN: %u (nfa at 0x%08x)\n", ufoImgGetU8(cfa - 1u), UFO_CFA_TO_NFA(cfa));
2567     fprintf(stderr, "  NAME(%u): ", nlen);
2568     for (uint32_t f = 0; f < nlen; f += 1) {
2569       const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2570       if (ch <= 32 || ch >= 127) {
2571         fprintf(stderr, "\\x%02x", ch);
2572       } else {
2573         fprintf(stderr, "%c", (char)ch);
2574       }
2575     }
2576     fprintf(stderr, "\n");
2577     ufo_assert(UFO_CFA_TO_LFA(cfa) == lfa);
2578   }
2579 }
2580
2581
2582 //==========================================================================
2583 //
2584 //  ufoVocCheckName
2585 //
2586 //  return 0 or CFA
2587 //
2588 //==========================================================================
2589 static uint32_t ufoVocCheckName (uint32_t lfa, const void *wname, uint32_t wnlen, uint32_t hash,
2590                                  int allowvochid)
2591 {
2592   uint32_t res = 0;
2593   #ifdef UFO_DEBUG_FIND_WORD
2594   fprintf(stderr, "CHECK-NAME: %.*s; LFA: 0x%08x; hash: 0x%08x (wname: 0x%08x)\n",
2595           (unsigned) wnlen, (const char *)wname,
2596           lfa, (lfa != 0 ? ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)) : 0), hash);
2597   ufoDumpWordHeader(lfa);
2598   #endif
2599   if (lfa != 0 && ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)) == hash) {
2600     const uint32_t lenflags = ufoImgGetU32(UFO_LFA_TO_NFA(lfa));
2601     if ((lenflags & UFW_FLAG_SMUDGE) == 0 &&
2602         (allowvochid || (lenflags & UFW_FLAG_HIDDEN) == 0))
2603     {
2604       const uint32_t nlen = lenflags&0xffU;
2605       if (nlen == wnlen) {
2606         uint32_t naddr = UFO_LFA_TO_NFA(lfa) + 4u;
2607         uint32_t pos = 0;
2608         while (pos < nlen) {
2609           uint8_t c0 = ((const unsigned char *)wname)[pos];
2610           if (c0 >= 'a' && c0 <= 'z') c0 = c0 - 'a' + 'A';
2611           uint8_t c1 = ufoImgGetU8(naddr + pos);
2612           if (c1 >= 'a' && c1 <= 'z') c1 = c1 - 'a' + 'A';
2613           if (c0 != c1) break;
2614           pos += 1u;
2615         }
2616         if (pos == nlen) {
2617           // i found her!
2618           naddr += pos + 1u;
2619           res = UFO_ALIGN4(naddr);
2620         }
2621       }
2622     }
2623   }
2624   return res;
2625 }
2626
2627
2628 //==========================================================================
2629 //
2630 //  ufoFindWordInVoc
2631 //
2632 //  return 0 or CFA
2633 //
2634 //==========================================================================
2635 static uint32_t ufoFindWordInVoc (const void *wname, uint32_t wnlen, uint32_t hash,
2636                                   uint32_t vocid, int allowvochid)
2637 {
2638   uint32_t res = 0;
2639   if (wname == NULL) ufo_assert(wnlen == 0);
2640   if (wnlen != 0 && vocid != 0) {
2641     if (hash == 0) hash = joaatHashBufCI(wname, wnlen);
2642     #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
2643     fprintf(stderr, "IN-VOC: %.*s; VOCID: 0x%08x; whash: 0x%08x; htbl[0]: 0x%08x\n",
2644             (unsigned) wnlen, (const char *)wname,
2645             vocid, hash, ufoImgGetU32(vocid + UFW_VOCAB_OFS_HTABLE));
2646     #endif
2647     const uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
2648     if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
2649       // hash table present, use it
2650       uint32_t bfa = htbl + (hash % (uint32_t)UFO_HASHTABLE_SIZE) * 4u;
2651       bfa = ufoImgGetU32(bfa);
2652       while (res == 0 && bfa != 0) {
2653         #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
2654         fprintf(stderr, "IN-VOC:   bfa: 0x%08x\n", bfa);
2655         #endif
2656         res = ufoVocCheckName(UFO_BFA_TO_LFA(bfa), wname, wnlen, hash, allowvochid);
2657         bfa = ufoImgGetU32(bfa);
2658       }
2659     } else {
2660       // no hash table, use linear search
2661       uint32_t lfa = vocid + UFW_VOCAB_OFS_LATEST;
2662       lfa = ufoImgGetU32(lfa);
2663       while (res == 0 && lfa != 0) {
2664         res = ufoVocCheckName(lfa, wname, wnlen, hash, allowvochid);
2665         lfa = ufoImgGetU32(lfa);
2666       }
2667     }
2668   }
2669   return res;
2670 }
2671
2672
2673 //==========================================================================
2674 //
2675 //  ufoFindColon
2676 //
2677 //  return part after the colon, or `NULL`
2678 //
2679 //==========================================================================
2680 static const void *ufoFindColon (const void *wname, uint32_t wnlen) {
2681   const void *res = NULL;
2682   if (wnlen != 0) {
2683     ufo_assert(wname != NULL);
2684     const char *str = (const char *)wname;
2685     while (wnlen != 0 && str[0] != ':') {
2686       str += 1; wnlen -= 1;
2687     }
2688     if (wnlen != 0) {
2689       res = (const void *)(str + 1); // skip colon
2690     }
2691   }
2692   return res;
2693 }
2694
2695
2696 //==========================================================================
2697 //
2698 //  ufoFindWordInVocAndParents
2699 //
2700 //==========================================================================
2701 static uint32_t ufoFindWordInVocAndParents (const void *wname, uint32_t wnlen, uint32_t hash,
2702                                             uint32_t vocid, int allowvochid)
2703 {
2704   uint32_t res = 0;
2705   if (hash == 0) hash = joaatHashBufCI(wname, wnlen);
2706   while (res == 0 && vocid != 0) {
2707     res = ufoFindWordInVoc(wname, wnlen, hash, vocid, allowvochid);
2708     vocid = ufoImgGetU32(vocid + UFW_VOCAB_OFS_PARENT);
2709   }
2710   return res;
2711 }
2712
2713
2714 //==========================================================================
2715 //
2716 //  ufoFindWordNameRes
2717 //
2718 //  find with name resolution
2719 //
2720 //  return 0 or CFA
2721 //
2722 //==========================================================================
2723 static uint32_t ufoFindWordNameRes (const void *wname, uint32_t wnlen) {
2724   uint32_t res = 0;
2725   if (wnlen != 0 && *(const char *)wname != ':') {
2726     ufo_assert(wname != NULL);
2727
2728     const void *stx = wname;
2729     wname = ufoFindColon(wname, wnlen);
2730     if (wname != NULL && wname != stx + wnlen) {
2731       // look in all vocabs (excluding hidden ones)
2732       uint32_t xlen = (uint32_t)(ptrdiff_t)(wname - stx) - 1u;
2733       ufo_assert(xlen > 0 && xlen < 255);
2734       uint32_t xhash = joaatHashBufCI(stx, xlen);
2735       uint32_t voclink = ufoImgGetU32(ufoAddrVocLink);
2736       #ifdef UFO_DEBUG_FIND_WORD_COLON
2737       fprintf(stderr, "COLON-FIND: first voc: {%.*s}; xhash=0x%08x; voc-link: 0x%08x\n",
2738               (unsigned)xlen, (const char *)stx, xhash, voclink);
2739       #endif
2740       while (res == 0 && voclink != 0) {
2741         const uint32_t vhdraddr = voclink - UFW_VOCAB_OFS_VOCLINK + UFW_VOCAB_OFS_HEADER;
2742         const uint32_t vhdr = ufoImgGetU32(vhdraddr);
2743         if (vhdr != 0) {
2744           res = ufoVocCheckName(UFO_NFA_TO_LFA(vhdr), stx, xlen, xhash, 0);
2745         }
2746         if (res == 0) voclink = ufoImgGetU32(voclink);
2747       }
2748       if (res != 0) {
2749         uint32_t vocid = voclink - UFW_VOCAB_OFS_VOCLINK;
2750         ufo_assert(voclink != 0);
2751         wnlen -= xlen + 1;
2752         #ifdef UFO_DEBUG_FIND_WORD_COLON
2753         fprintf(stderr, "searching {%.*s}(%u) in {%.*s}\n",
2754                 (unsigned)wnlen, wname, wnlen, (unsigned)xlen, stx);
2755         #endif
2756         while (res != 0 && wname != NULL) {
2757           // first, the whole rest
2758           res = ufoFindWordInVocAndParents(wname, wnlen, 0, vocid, 1);
2759           if (res != 0) {
2760             wname = NULL;
2761           } else {
2762             stx = wname;
2763             wname = ufoFindColon(wname, wnlen);
2764             if (wname == NULL) xlen = wnlen; else xlen = (uint32_t)(ptrdiff_t)(wname - stx) - 1u;
2765             ufo_assert(xlen > 0 && xlen < 255);
2766             res = ufoFindWordInVocAndParents(stx, xlen, 0, vocid, 1);
2767             if (res != 0) {
2768               wnlen -= xlen + 1;
2769               if (wname != NULL) {
2770                 // it should be a vocabulary
2771                 const uint32_t nfa = UFO_CFA_TO_NFA(res);
2772                 if ((ufoImgGetU32(nfa) & UFW_FLAG_VOCAB) != 0) {
2773                   vocid = ufoImgGetU32(UFO_CFA_TO_PFA(res)); // pfa points to vocabulary
2774                 } else {
2775                   res = 0;
2776                 }
2777               }
2778             }
2779           }
2780         }
2781       }
2782     }
2783   }
2784
2785   return res;
2786 }
2787
2788
2789 //==========================================================================
2790 //
2791 //  ufoFindWord
2792 //
2793 //  doesn't look in CURRENT, does name resolution ("a:b" is word "b" in "a")
2794 //
2795 //  return 0 or CFA
2796 //
2797 //==========================================================================
2798 static uint32_t ufoFindWord (const char *wname) {
2799   uint32_t res = 0;
2800   if (wname && wname[0] != 0) {
2801     const size_t wnlen = strlen(wname);
2802     ufo_assert(wnlen < 8192);
2803     uint32_t ctx = ufoImgGetU32(ufoAddrContext);
2804     const uint32_t hash = joaatHashBufCI(wname, (uint32_t)wnlen);
2805
2806     //fprintf(stderr, "FIND-WORD: whash: 0x%08x; name:{%s}\n", hash, wname);
2807
2808     // first search in context
2809     res = ufoFindWordInVocAndParents(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
2810
2811     // now try vocabulary stack
2812     uint32_t vstp = ufoVSP;
2813     while (res == 0 && vstp != 0) {
2814       vstp -= 1;
2815       ctx = ufoVocStack[vstp];
2816       res = ufoFindWordInVocAndParents(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
2817     }
2818
2819     // if not found, try name resolution
2820     if (res == 0) res = ufoFindWordNameRes(wname, (uint32_t)wnlen);
2821   }
2822
2823   return res;
2824 }
2825
2826
2827 //==========================================================================
2828 //
2829 //  ufoCreateWordHeader
2830 //
2831 //  create word header up to CFA, link to the current dictionary
2832 //
2833 //==========================================================================
2834 static void ufoCreateWordHeader (const char *wname, uint32_t flags) {
2835   if (wname == NULL) wname = "";
2836   const size_t wnlen = strlen(wname);
2837   ufo_assert(wnlen < UFO_MAX_WORD_LENGTH);
2838   const uint32_t hash = joaatHashBufCI(wname, (uint32_t)wnlen);
2839   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
2840   ufo_assert(curr != 0);
2841
2842   // redefine check
2843   const uint32_t warn = ufoImgGetU32(ufoAddrRedefineWarning);
2844   if (wnlen != 0 && warn != UFO_REDEF_WARN_DONT_CARE) {
2845     uint32_t cfa;
2846     if (warn != UFO_REDEF_WARN_PARENTS) {
2847       cfa = ufoFindWordInVoc(wname, wnlen, hash, curr, 1);
2848     } else {
2849       cfa = ufoFindWordInVocAndParents(wname, wnlen, hash, curr, 1);
2850     }
2851     if (cfa != 0) {
2852       const uint32_t nfa = UFO_CFA_TO_NFA(cfa);
2853       const uint32_t flags = ufoImgGetU32(nfa);
2854       if ((flags & UFW_FLAG_PROTECTED) != 0) {
2855         ufoFatal("trying to redefine protected word '%s'", wname);
2856       } else if (warn != UFO_REDEF_WARN_NONE) {
2857         ufoWarning("redefining word '%s'", wname);
2858       }
2859     }
2860   }
2861
2862   const uint32_t bkt = (hash % (uint32_t)UFO_HASHTABLE_SIZE) * 4u;
2863   const uint32_t htbl = curr + UFW_VOCAB_OFS_HTABLE;
2864
2865   ufoImgEmitAlign();
2866   const uint32_t xfaAddr = UFO_GET_DP();
2867   if ((xfaAddr & UFO_ADDR_TEMP_BIT) == 0) {
2868     // link previous yfa here
2869     const uint32_t lastxfa = ufoImgGetU32(ufoAddrLastXFA);
2870     // fix YFA of the previous word (it points to our YFA)
2871     if (lastxfa != 0) {
2872       ufoImgPutU32(UFO_XFA_TO_YFA(lastxfa), UFO_XFA_TO_YFA(xfaAddr));
2873     }
2874     // our XFA points to the previous XFA
2875     ufoImgEmitU32(lastxfa); // xfa
2876     // update last XFA
2877     ufoImgPutU32(ufoAddrLastXFA, xfaAddr);
2878   } else {
2879     ufoImgEmitU32(0); // xfa
2880   }
2881   ufoImgEmitU32(0); // yfa
2882
2883   // bucket link (bfa)
2884   if (wnlen == 0 || ufoImgGetU32(htbl) == UFO_NO_HTABLE_FLAG) {
2885     ufoImgEmitU32(0);
2886   } else {
2887     #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
2888     fprintf(stderr, "NEW HEADER: %s; curr: 0x%08x; htbl: 0x%08x; bkt: 0x%08x\n",
2889             wname, curr, htbl, bkt);
2890     fprintf(stderr, "  [bkt]: 0x%08x; nbk: 0x%08x\n", ufoImgGetU32(htbl + bkt), UFO_GET_DP());
2891     #endif
2892     // bfa points to bfa
2893     const uint32_t bfa = UFO_GET_DP();
2894     ufoImgEmitU32(ufoImgGetU32(htbl + bkt));
2895     ufoImgPutU32(htbl + bkt, bfa);
2896   }
2897
2898   // lfa
2899   const uint32_t lfa = UFO_GET_DP();
2900   ufoImgEmitU32(ufoImgGetU32(curr + UFW_VOCAB_OFS_LATEST));
2901   // fix voc latest
2902   ufoImgPutU32(curr + UFW_VOCAB_OFS_LATEST, lfa);
2903   // name hash
2904   ufoImgEmitU32(hash);
2905   // name length
2906   const uint32_t nfa = UFO_GET_DP();
2907   ufoImgEmitU32(((uint32_t)wnlen&0xffU) | (flags & 0xffffff00U));
2908   const uint32_t nstart = UFO_GET_DP();
2909   // put name
2910   for (size_t f = 0; f < wnlen; f += 1) {
2911     ufoImgEmitU8(((const unsigned char *)wname)[f]);
2912   }
2913   while ((UFO_GET_DP() & 3) != 3) ufoImgEmitU8(0);
2914   const uint32_t nend = UFO_GET_DP(); // length byte itself is not included
2915   // name length, again
2916   ufo_assert(nend - nstart <= 255);
2917   ufoImgEmitU8((uint8_t)(nend - nstart));
2918   ufo_assert((UFO_GET_DP() & 3) == 0);
2919   ufo_assert(UFO_CFA_TO_NFA(UFO_GET_DP()) == nfa);
2920   if ((nend & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(nend);
2921   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
2922   fprintf(stderr, "*** NEW HEADER ***\n");
2923   fprintf(stderr, "CFA: 0x%08x\n", UFO_GET_DP());
2924   fprintf(stderr, "NSTART: 0x%08x\n", nstart);
2925   fprintf(stderr, "NEND: 0x%08x\n", nend);
2926   fprintf(stderr, "NLEN: %u (%u)\n", nend - nstart, ufoImgGetU8(UFO_GET_DP() - 1u));
2927   ufoDumpWordHeader(lfa);
2928   #endif
2929   #if 0
2930   fprintf(stderr, "NEW WORD CFA 0x%08x: %s\n", UFO_GET_DP(), wname);
2931   #endif
2932 }
2933
2934
2935 //==========================================================================
2936 //
2937 //  ufoDecompilePart
2938 //
2939 //==========================================================================
2940 static void ufoDecompilePart (uint32_t addr, uint32_t eaddr, int indent) {
2941   uint32_t count;
2942   FILE *fo = stdout;
2943   while (addr < eaddr) {
2944     uint32_t cfa = ufoImgGetU32(addr);
2945     for (int n = 0; n < indent; n += 1) fputc(' ', fo);
2946     fprintf(fo, "%6u: 0x%08x: ", addr, cfa);
2947     uint32_t nfa = UFO_CFA_TO_NFA(cfa);
2948     uint32_t flags = ufoImgGetU32(nfa);
2949     //fprintf(fo, "[0x%08x] ", flags & UFW_WARG_MASK);
2950     uint32_t nlen = flags & 0xffU;
2951     for (uint32_t f = 0; f < nlen; f += 1) {
2952       const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2953       if (ch <= 32 || ch >= 127) {
2954         fprintf(fo, "\\x%02x", ch);
2955       } else {
2956         fprintf(fo, "%c", (char)ch);
2957       }
2958     }
2959     addr += 4u;
2960     switch (flags & UFW_WARG_MASK) {
2961       case UFW_WARG_NONE:
2962         break;
2963       case UFW_WARG_BRANCH:
2964         #ifdef UFO_RELATIVE_BRANCH
2965         fprintf(fo, "  @%u", addr + ufoImgGetU32(addr)); addr += 4u;
2966         #else
2967         fprintf(fo, "  @%u", ufoImgGetU32(addr)); addr += 4u;
2968         #endif
2969         break;
2970       case UFW_WARG_LIT:
2971         fprintf(fo, "  %u : %d : 0x%08x", ufoImgGetU32(addr),
2972                 (int32_t)ufoImgGetU32(addr), ufoImgGetU32(addr)); addr += 4u;
2973         break;
2974       case UFW_WARG_C4STRZ:
2975         count = ufoImgGetU32(addr); addr += 4;
2976        print_str:
2977         fprintf(fo, "  str:");
2978         for (int f = 0; f < count; f += 1) {
2979           const uint8_t ch = ufoImgGetU8(addr); addr += 1u;
2980           if (ch <= 32 || ch >= 127) {
2981             fprintf(fo, "\\x%02x", ch);
2982           } else {
2983             fprintf(fo, "%c", (char)ch);
2984           }
2985         }
2986         addr += 1u; // skip zero byte
2987         addr = UFO_ALIGN4(addr);
2988         break;
2989       case UFW_WARG_CFA:
2990         cfa = ufoImgGetU32(addr); addr += 4u;
2991         fprintf(fo, "  CFA:%u: ", cfa);
2992         nfa = UFO_CFA_TO_NFA(cfa);
2993         nlen = ufoImgGetU8(nfa);
2994         for (uint32_t f = 0; f < nlen; f += 1) {
2995           const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2996           if (ch <= 32 || ch >= 127) {
2997             fprintf(fo, "\\x%02x", ch);
2998           } else {
2999             fprintf(fo, "%c", (char)ch);
3000           }
3001         }
3002         break;
3003       case UFW_WARG_PFA:
3004         cfa = ufoImgGetU32(addr); addr += 4u;
3005         fprintf(fo, "  PFA:%u: ", cfa);
3006         cfa = UFO_PFA_TO_CFA(cfa);
3007         nfa = UFO_CFA_TO_NFA(cfa);
3008         nlen = ufoImgGetU8(nfa);
3009         for (uint32_t f = 0; f < nlen; f += 1) {
3010           const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
3011           if (ch <= 32 || ch >= 127) {
3012             fprintf(fo, "\\x%02x", ch);
3013           } else {
3014             fprintf(fo, "%c", (char)ch);
3015           }
3016         }
3017         break;
3018       case UFW_WARG_CBLOCK:
3019         fprintf(fo, "  CBLOCK:%u", ufoImgGetU32(addr)); addr += 4u;
3020         break;
3021       case UFW_WARG_VOCID:
3022         fprintf(fo, "  VOCID:%u", ufoImgGetU32(addr)); addr += 4u;
3023         break;
3024       case UFW_WARG_C1STRZ:
3025         count = ufoImgGetU8(addr); addr += 1;
3026         goto print_str;
3027       case UFW_WARG_DATASKIP:
3028         fprintf(fo, "  DATA:%u", ufoImgGetU32(addr));
3029         addr += UFO_ALIGN4(4u + ufoImgGetU32(addr));
3030         break;
3031       default:
3032         fprintf(fo, " -- WTF?!\n");
3033         abort();
3034     }
3035     fputc('\n', fo);
3036   }
3037 }
3038
3039
3040 //==========================================================================
3041 //
3042 //  ufoDecompileWord
3043 //
3044 //==========================================================================
3045 static void ufoDecompileWord (const uint32_t cfa) {
3046   if (cfa != 0) {
3047     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
3048     fprintf(stdout, "#### DECOMPILING CFA %u ###\n", cfa);
3049     ufoDumpWordHeader(lfa);
3050     const uint32_t yfa = ufoGetWordEndAddr(cfa);
3051     if (ufoImgGetU32(cfa) == ufoDoForthCFA) {
3052       fprintf(stdout, "--- DECOMPILED CODE ---\n");
3053       ufoDecompilePart(UFO_CFA_TO_PFA(cfa), yfa, 0);
3054       fprintf(stdout, "=======================\n");
3055     }
3056   }
3057 }
3058
3059
3060 //==========================================================================
3061 //
3062 //  ufoBTShowWordName
3063 //
3064 //==========================================================================
3065 static void ufoBTShowWordName (uint32_t nfa) {
3066   if (nfa != 0) {
3067     uint32_t len = ufoImgGetU8(nfa); nfa += 4u;
3068     //fprintf(stderr, "(0x%08x)", ufoImgGetU32(nfa - 4u));
3069     while (len != 0) {
3070       uint8_t ch = ufoImgGetU8(nfa); nfa += 1u; len -= 1u;
3071       if (ch <= 32 || ch >= 127) {
3072         fprintf(stderr, "\\x%02x", ch);
3073       } else {
3074         fprintf(stderr, "%c", (char)ch);
3075       }
3076     }
3077   }
3078 }
3079
3080
3081 //==========================================================================
3082 //
3083 //  ufoBacktrace
3084 //
3085 //==========================================================================
3086 static void ufoBacktrace (uint32_t ip, int showDataStack) {
3087   // dump data stack (top 16)
3088   ufoFlushOutput();
3089   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3090
3091   if (showDataStack) {
3092     fprintf(stderr, "***UFO STACK DEPTH: %u\n", ufoSP);
3093     uint32_t xsp = ufoSP;
3094     if (xsp > 16) xsp = 16;
3095     for (uint32_t sp = 0; sp < xsp; ++sp) {
3096       fprintf(stderr, "  %2u: 0x%08x  %d%s\n",
3097               sp, ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1],
3098               (sp == 0 ? " -- TOS" : ""));
3099     }
3100     if (ufoSP > 16) fprintf(stderr, "    ...more...\n");
3101   }
3102
3103   // dump return stack (top 32)
3104   uint32_t nfa;
3105   uint32_t fline;
3106   const char *fname;
3107
3108   fprintf(stderr, "***UFO RETURN STACK DEPTH: %u\n", ufoRP);
3109   if (ip != 0) {
3110     nfa = ufoFindWordForIP(ip);
3111     if (nfa != 0) {
3112       fprintf(stderr, "  **: %8u -- ", ip);
3113       ufoBTShowWordName(nfa);
3114       fname = ufoFindFileForIP(ip, &fline, NULL, NULL);
3115       if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }
3116       fputc('\n', stderr);
3117     }
3118   }
3119   uint32_t rp = ufoRP;
3120   uint32_t rscount = 0;
3121   if (rp > UFO_RSTACK_SIZE) rp = UFO_RSTACK_SIZE;
3122   while (rscount != 32 && rp != 0) {
3123     rp -= 1;
3124     const uint32_t val = ufoRStack[rp];
3125     nfa = ufoFindWordForIP(val - 4u);
3126     if (nfa != 0) {
3127       fprintf(stderr, "  %2u: %8u -- ", ufoRP - rp - 1u, val);
3128       ufoBTShowWordName(nfa);
3129       fname = ufoFindFileForIP(val - 4u, &fline, NULL, NULL);
3130       if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }
3131       fputc('\n', stderr);
3132     } else {
3133       fprintf(stderr, "  %2u: 0x%08x  %d\n", ufoRP - rp - 1u, val, (int32_t)val);
3134     }
3135     rscount += 1;
3136   }
3137   if (ufoRP > 32) fprintf(stderr, "    ...more...\n");
3138
3139   ufoFlushOutput();
3140 }
3141
3142
3143 //==========================================================================
3144 //
3145 //  ufoDumpVocab
3146 //
3147 //==========================================================================
3148 /*
3149 static void ufoDumpVocab (uint32_t vocid) {
3150   if (vocid != 0) {
3151     fprintf(stderr, "*** VOCID: 0x%08x ***\n", vocid);
3152     uint32_t vochdr = vocid + UFW_VOCAB_OFS_HEADER;
3153     vochdr = ufoImgGetU32(vochdr);
3154     if (vochdr != 0) {
3155       fprintf(stderr, "--- HEADER ---\n");
3156       ufoDumpWordHeader(UFO_NFA_TO_LFA(vochdr));
3157       fprintf(stderr, "========\n");
3158       uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
3159       if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
3160         fprintf(stderr, "--- HASH TABLE ---\n");
3161         for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) {
3162           uint32_t bfa = ufoImgGetU32(htbl);
3163           if (bfa != 0) {
3164             fprintf(stderr, "**** %2d: 0x%08x\n", f, bfa);
3165             do {
3166               ufoDumpWordHeader(UFO_BFA_TO_LFA(bfa));
3167               bfa = ufoImgGetU32(bfa);
3168             } while (bfa != 0);
3169           }
3170           htbl += 4u;
3171         }
3172       }
3173     }
3174   }
3175 }
3176 */
3177
3178
3179 // if set, this will be used when we are out of include files. intended for UrAsm.
3180 // return 0 if there is no more lines, otherwise the string should be copied
3181 // to buffer, `*fname` and `*fline` should be properly set.
3182 int (*ufoFileReadLine) (void *buf, size_t bufsize, const char **fname, int *fline) = NULL;
3183
3184
3185 //==========================================================================
3186 //
3187 //  ufoLoadNextUserLine
3188 //
3189 //==========================================================================
3190 static int ufoLoadNextUserLine (void) {
3191   uint32_t tibPos = 0;
3192   const char *fname = NULL;
3193   int fline = 0;
3194   ufoResetTib();
3195   if (ufoFileReadLine != NULL && ufoFileReadLine(ufoCurrFileLine, 510, &fname, &fline) != 0) {
3196     ufoCurrFileLine[510] = 0;
3197     uint32_t slen = (uint32_t)strlen(ufoCurrFileLine);
3198     while (slen != 0 && (ufoCurrFileLine[slen - 1u] == 10 || ufoCurrFileLine[slen - 1u] == 13)) {
3199       slen -= 1u;
3200     }
3201     if (tibPos + slen + 1u > UFO_ADDR_HANDLE_OFS_MASK) {
3202       ufoFatal("input text line too long (at least %u bytes)", tibPos + slen);
3203     }
3204     ufoTibEnsureSize(tibPos + slen + 1u);
3205     for (uint32_t f = 0; f < slen; f += 1) {
3206       ufoTibPokeChOfs(((const unsigned char *)ufoCurrFileLine)[f], tibPos + f);
3207     }
3208     ufoTibPokeChOfs(0, tibPos + slen);
3209     tibPos += slen;
3210     if (fname == NULL) fname = "<user>";
3211     ufoSetInFileName(fname);
3212     ufoInFileLine = fline;
3213     return 1;
3214   } else {
3215     return 0;
3216   }
3217 }
3218
3219
3220 //==========================================================================
3221 //
3222 //  ufoLoadNextLine_NativeMode
3223 //
3224 //  load next file line into TIB
3225 //  always strips final '\n'
3226 //
3227 //  return 0 on EOF, 1 on success
3228 //
3229 //==========================================================================
3230 static int ufoLoadNextLine (int crossInclude) {
3231   int done = 0;
3232   uint32_t tibPos = 0;
3233   ufoResetTib();
3234
3235   if (ufoMode == UFO_MODE_MACRO) {
3236     //fprintf(stderr, "***MAC!\n");
3237     return 0;
3238   }
3239
3240   while (ufoInFile != NULL && !done) {
3241     ufoCurrIncludeLineFileOfs = ftell(ufoInFile);
3242     if (fgets(ufoCurrFileLine, 510, ufoInFile) != NULL) {
3243       // check for a newline
3244       // if there is no newline char at the end, the string was truncated
3245       ufoCurrFileLine[510] = 0;
3246       const uint32_t slen = (uint32_t)strlen(ufoCurrFileLine);
3247       if (tibPos + slen + 1u > UFO_ADDR_HANDLE_OFS_MASK) {
3248         ufoFatal("input text line too long (at least %u bytes)", tibPos + slen);
3249       }
3250       ufoTibEnsureSize(tibPos + slen + 1u);
3251       for (uint32_t f = 0; f < slen; f += 1) {
3252         ufoTibPokeChOfs(((const unsigned char *)ufoCurrFileLine)[f], tibPos + f);
3253       }
3254       ufoTibPokeChOfs(0, tibPos + slen);
3255       tibPos += slen;
3256       if (slen != 0 && (ufoCurrFileLine[slen - 1u] == 13 || ufoCurrFileLine[slen - 1u] == 10)) {
3257         ++ufoInFileLine;
3258         done = 1;
3259       } else {
3260         // continuation, nothing to do
3261       }
3262     } else {
3263       // if we read nothing, this is EOF
3264       if (tibPos == 0 && crossInclude) {
3265         // we read nothing, and allowed to cross include boundaries
3266         ufoPopInFile();
3267       } else {
3268         done = 1;
3269       }
3270     }
3271   }
3272
3273   if (tibPos == 0) {
3274     // eof, try user-supplied input
3275     if (ufoFileStackPos == 0) {
3276       return ufoLoadNextUserLine();
3277     } else {
3278       return 0;
3279     }
3280   } else {
3281     // if we read at least something, this is not EOF
3282     return 1;
3283   }
3284 }
3285
3286
3287 // ////////////////////////////////////////////////////////////////////////// //
3288 // debug
3289
3290 // DUMP-STACK
3291 // ( -- )
3292 UFWORD(DUMP_STACK) {
3293   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3294   printf("***UFO STACK DEPTH: %u\n", ufoSP);
3295   uint32_t xsp = ufoSP;
3296   if (xsp > 16) xsp = 16;
3297   for (uint32_t sp = 0; sp < xsp; ++sp) {
3298     printf("  %2u: 0x%08x  %d%s\n",
3299            sp, ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1],
3300            (sp == 0 ? " -- TOS" : ""));
3301   }
3302   if (ufoSP > 16) printf("    ...more...\n");
3303   ufoLastEmitWasCR = 1;
3304 }
3305
3306 // BACKTRACE
3307 // ( -- )
3308 UFWORD(UFO_BACKTRACE) {
3309   ufoFlushOutput();
3310   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3311   if (ufoInFile != NULL) {
3312     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
3313   } else {
3314     fprintf(stderr, "*** somewhere in time ***\n");
3315   }
3316   ufoBacktrace(ufoIP, 1);
3317 }
3318
3319 #ifdef UFO_MTASK_ALLOWED
3320 // DUMP-STACK-TASK
3321 // ( stid -- )
3322 UFWORD(DUMP_STACK_TASK) {
3323   UfoState *st = ufoFindState(ufoPop());
3324   if (st == NULL) ufoFatal("invalid state id");
3325   // temporarily switch the task
3326   UfoState *oldst = ufoCurrState; ufoCurrState = st;
3327   // dump
3328   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3329   printf("***UFO STACK DEPTH: %u\n", ufoSP);
3330   uint32_t xsp = ufoSP;
3331   if (xsp > 16) xsp = 16;
3332   for (uint32_t sp = 0; sp < xsp; ++sp) {
3333     printf("  %2u: 0x%08x  %d%s\n",
3334            sp, ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1],
3335            (sp == 0 ? " -- TOS" : ""));
3336   }
3337   if (ufoSP > 16) printf("    ...more...\n");
3338   ufoLastEmitWasCR = 1;
3339   // restore state
3340   ufoCurrState = oldst;
3341 }
3342
3343 // DUMP-RSTACK-TASK
3344 // ( stid -- )
3345 UFWORD(DUMP_RSTACK_TASK) {
3346   UfoState *st = ufoFindState(ufoPop());
3347   if (st == NULL) ufoFatal("invalid state id");
3348   // temporarily switch the task
3349   UfoState *oldst = ufoCurrState; ufoCurrState = st;
3350   // dump
3351   ufoFlushOutput();
3352   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3353   if (ufoInFile != NULL) {
3354     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
3355   } else {
3356     fprintf(stderr, "*** somewhere in time ***\n");
3357   }
3358   ufoBacktrace(ufoIP, 0);
3359   // restore state
3360   ufoCurrState = oldst;
3361 }
3362
3363 // BACKTRACE-TASK
3364 // ( stid -- )
3365 UFWORD(UFO_BACKTRACE_TASK) {
3366   UfoState *st = ufoFindState(ufoPop());
3367   if (st == NULL) ufoFatal("invalid state id");
3368   // temporarily switch the task
3369   UfoState *oldst = ufoCurrState; ufoCurrState = st;
3370   // dump
3371   ufoFlushOutput();
3372   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3373   if (ufoInFile != NULL) {
3374     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
3375   } else {
3376     fprintf(stderr, "*** somewhere in time ***\n");
3377   }
3378   ufoBacktrace(ufoIP, 1);
3379   // restore state
3380   ufoCurrState = oldst;
3381 }
3382 #endif
3383
3384
3385 // ////////////////////////////////////////////////////////////////////////// //
3386 // some init words, and PAD
3387 //
3388
3389 // NOOP
3390 // ( -- )
3391 UFWORD(NOOP) {}
3392
3393 // (NOTIMPL)
3394 // ( -- )
3395 UFWORD(PAR_NOTIMPL) {
3396   ufoFatal("not implemented");
3397 }
3398
3399 // SP0!
3400 // ( -- )
3401 UFWORD(SP0_STORE) { ufoSP = 0; }
3402
3403 // RP0!
3404 // ( -- )
3405 UFWORD(RP0_STORE) {
3406   ufoRP = 0;
3407 }
3408
3409 // PAD
3410 // ( -- pad )
3411 // PAD is at the beginning of temp area
3412 UFWORD(PAD) {
3413   ufoPush(UFO_PAD_ADDR);
3414 }
3415
3416 // HERE
3417 // ( -- here )
3418 UFWORD(HERE) {
3419   ufoPush(UFO_GET_DP());
3420 }
3421
3422 // ALIGN-HERE
3423 // ( -- )
3424 UFWORD(ALIGN_HERE) {
3425   ufoImgEmitAlign();
3426 }
3427
3428
3429 // ////////////////////////////////////////////////////////////////////////// //
3430 // peeks and pokes with address register
3431 //
3432
3433 // A>
3434 // ( -- regA )
3435 UFWORD(REGA_LOAD) {
3436   ufoPush(ufoRegA);
3437 }
3438
3439 // >A
3440 // ( regA -- )
3441 UFWORD(REGA_STORE) {
3442   ufoRegA = ufoPop();
3443 }
3444
3445 // A-SWAP
3446 // ( regA -- oldA )
3447 // swap TOS and A
3448 UFWORD(REGA_SWAP) {
3449   const uint32_t newa = ufoPop();
3450   ufoPush(ufoRegA);
3451   ufoRegA = newa;
3452 }
3453
3454 // +1>A
3455 // ( -- )
3456 UFWORD(REGA_INC) {
3457   ufoRegA += 1u;
3458 }
3459
3460 // +2>A
3461 // ( -- )
3462 UFWORD(REGA_INC_WORD) {
3463   ufoRegA += 2u;
3464 }
3465
3466 // +4>A
3467 // ( -- )
3468 UFWORD(REGA_INC_CELL) {
3469   ufoRegA += 4u;
3470 }
3471
3472 // -1>A
3473 // ( -- )
3474 UFWORD(REGA_DEC) {
3475   ufoRegA -= 1u;
3476 }
3477
3478 // -2>A
3479 // ( -- )
3480 UFWORD(REGA_DEC_WORD) {
3481   ufoRegA -= 2u;
3482 }
3483
3484 // -4>A
3485 // ( -- )
3486 UFWORD(REGA_DEC_CELL) {
3487   ufoRegA -= 4u;
3488 }
3489
3490 // A>R
3491 // ( -- | rega )
3492 UFWORD(REGA_TO_R) {
3493   ufoRPush(ufoRegA);
3494 }
3495
3496 // R>A
3497 // ( | rega -- )
3498 UFWORD(R_TO_REGA) {
3499   ufoRegA = ufoRPop();
3500 }
3501
3502
3503 // ////////////////////////////////////////////////////////////////////////// //
3504 // useful to work with handles and normal addreses uniformly
3505 //
3506
3507 // C@A
3508 // ( -- byte )
3509 UFWORD(CPEEK_REGA) {
3510   ufoPush(ufoImgGetU8(ufoRegA));
3511 }
3512
3513 // W@A
3514 // ( -- word )
3515 UFWORD(WPEEK_REGA) {
3516   ufoPush(ufoImgGetU16(ufoRegA));
3517 }
3518
3519 // @A
3520 // ( -- value )
3521 UFWORD(PEEK_REGA) {
3522   ufoPush(ufoImgGetU32(ufoRegA));
3523 }
3524
3525 // C!A
3526 // ( byte -- )
3527 UFWORD(CPOKE_REGA) {
3528   ufoImgPutU8(ufoRegA, ufoPop());
3529 }
3530
3531 // W!A
3532 // ( word -- )
3533 UFWORD(WPOKE_REGA) {
3534   ufoImgPutU16(ufoRegA, ufoPop());
3535 }
3536
3537 // !A
3538 // ( value -- )
3539 UFWORD(POKE_REGA) {
3540   ufoImgPutU32(ufoRegA, ufoPop());
3541 }
3542
3543 // C@A+
3544 // ( idx -- byte )
3545 UFWORD(CPEEK_REGA_IDX) {
3546   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3547     UFO_STACK(1);
3548     const uint32_t newaddr = ufoRegA + UFO_TOS;
3549     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK)) {
3550       UFO_TOS = ufoImgGetU8(newaddr);
3551     } else {
3552       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3553                ufoRegA, UFO_TOS, newaddr);
3554     }
3555   } else {
3556     ufoPush(ufoRegA);
3557     UFCALL(PAR_HANDLE_LOAD_BYTE);
3558   }
3559 }
3560
3561 // W@A+
3562 // ( idx -- word )
3563 UFWORD(WPEEK_REGA_IDX) {
3564   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3565     UFO_STACK(1);
3566     const uint32_t newaddr = ufoRegA + UFO_TOS;
3567     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3568         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 1u) & UFO_ADDR_SPECIAL_BITS_MASK))
3569     {
3570       UFO_TOS = ufoImgGetU16(newaddr);
3571     } else {
3572       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3573                ufoRegA, UFO_TOS, newaddr);
3574     }
3575   } else {
3576     ufoPush(ufoRegA);
3577     UFCALL(PAR_HANDLE_LOAD_WORD);
3578   }
3579 }
3580
3581 // @A+
3582 // ( idx -- value )
3583 UFWORD(PEEK_REGA_IDX) {
3584   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3585     UFO_STACK(1);
3586     const uint32_t newaddr = ufoRegA + UFO_TOS;
3587     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3588         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 3u) & UFO_ADDR_SPECIAL_BITS_MASK))
3589     {
3590       UFO_TOS = ufoImgGetU32(newaddr);
3591     } else {
3592       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3593                ufoRegA, UFO_TOS, newaddr);
3594     }
3595   } else {
3596     ufoPush(ufoRegA);
3597     UFCALL(PAR_HANDLE_LOAD_CELL);
3598   }
3599 }
3600
3601 // C!A+
3602 // ( byte idx -- )
3603 UFWORD(CPOKE_REGA_IDX) {
3604   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3605     const uint32_t idx = ufoPop();
3606     const uint32_t newaddr = ufoRegA + idx;
3607     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK)) {
3608       const uint32_t value = ufoPop();
3609       ufoImgPutU8(newaddr, value);
3610     } else {
3611       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3612                ufoRegA, idx, newaddr);
3613     }
3614   } else {
3615     ufoPush(ufoRegA);
3616     UFCALL(PAR_HANDLE_STORE_BYTE);
3617   }
3618 }
3619
3620 // W!A+
3621 // ( word idx -- )
3622 UFWORD(WPOKE_REGA_IDX) {
3623   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3624     const uint32_t idx = ufoPop();
3625     const uint32_t newaddr = ufoRegA + idx;
3626     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3627         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 1u) & UFO_ADDR_SPECIAL_BITS_MASK))
3628     {
3629       const uint32_t value = ufoPop();
3630       ufoImgPutU16(newaddr, value);
3631     } else {
3632       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3633                ufoRegA, idx, newaddr);
3634     }
3635   } else {
3636     ufoPush(ufoRegA);
3637     UFCALL(PAR_HANDLE_STORE_WORD);
3638   }
3639 }
3640
3641 // !A+
3642 // ( value idx -- )
3643 UFWORD(POKE_REGA_IDX) {
3644   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3645     const uint32_t idx = ufoPop();
3646     const uint32_t newaddr = ufoRegA + idx;
3647     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3648         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 3u) & UFO_ADDR_SPECIAL_BITS_MASK))
3649     {
3650       const uint32_t value = ufoPop();
3651       ufoImgPutU32(newaddr, value);
3652     } else {
3653       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3654                ufoRegA, idx, newaddr);
3655     }
3656   } else {
3657     ufoPush(ufoRegA);
3658     UFCALL(PAR_HANDLE_STORE_CELL);
3659   }
3660 }
3661
3662 // C!+1>A
3663 // ( byte -- )
3664 UFWORD(CPOKE_REGA_INC1) {
3665   ufoImgPutU8(ufoRegA, ufoPop());
3666   ufoRegA += 1u;
3667 }
3668
3669 // W!+2>A
3670 // ( byte -- )
3671 UFWORD(WPOKE_REGA_INC2) {
3672   ufoImgPutU16(ufoRegA, ufoPop());
3673   ufoRegA += 2u;
3674 }
3675
3676 // !+4>A
3677 // ( val32 -- )
3678 UFWORD(POKE_REGA_INC4) {
3679   ufoImgPutU32(ufoRegA, ufoPop());
3680   ufoRegA += 4u;
3681 }
3682
3683 // C@+1>A
3684 // ( -- byte )
3685 UFWORD(CPEEK_REGA_INC1) {
3686   ufoPush(ufoImgGetU8(ufoRegA));
3687   ufoRegA += 1u;
3688 }
3689
3690 // W@+2>A
3691 // ( -- byte )
3692 UFWORD(WPEEK_REGA_INC2) {
3693   ufoPush(ufoImgGetU16(ufoRegA));
3694   ufoRegA += 2u;
3695 }
3696
3697 // @+4>A
3698 // ( -- val32 )
3699 UFWORD(PEEK_REGA_INC4) {
3700   ufoPush(ufoImgGetU32(ufoRegA));
3701   ufoRegA += 4u;
3702 }
3703
3704
3705 // ////////////////////////////////////////////////////////////////////////// //
3706 // peeks and pokes
3707 //
3708
3709 // COMPILER:CFA,
3710 // ( cfa -- )
3711 UFWORD(CFA_COMMA) {
3712   const uint32_t cfa = ufoPop();
3713   ufoImgEmitCFA(cfa);
3714 }
3715
3716 // (BRANCH-ADDR!)
3717 // ( destaddr addr -- )
3718 // write "branch to destaddr" address to addr
3719 UFWORD(PAR_BRANCH_ADDR_POKE) {
3720   const uint32_t addr = ufoPop();
3721   const uint32_t dest = ufoPop();
3722   #ifdef UFO_RELATIVE_BRANCH
3723   ufoImgPutU32(addr, dest - addr);
3724   #else
3725   ufoImgPutU32(addr, dest);
3726   #endif
3727 }
3728
3729 // (BRANCH-ADDR@)
3730 // ( addr -- dest )
3731 // read branch address
3732 UFWORD(PAR_BRANCH_ADDR_PEEK) {
3733   UFO_STACK(1);
3734   #ifdef UFO_RELATIVE_BRANCH
3735   UFO_TOS += ufoImgGetU32(UFO_TOS);
3736   #else
3737   UFO_TOS = ufoImgGetU32(UFO_TOS);
3738   #endif
3739 }
3740
3741 // C@
3742 // ( addr -- value8 )
3743 UFWORD(CPEEK) {
3744   UFO_STACK(1);
3745   UFO_TOS = ufoImgGetU8(UFO_TOS);
3746 }
3747
3748 // W@
3749 // ( addr -- value16 )
3750 UFWORD(WPEEK) {
3751   UFO_STACK(1);
3752   UFO_TOS = ufoImgGetU16(UFO_TOS);
3753 }
3754
3755 // @
3756 // ( addr -- value32 )
3757 UFWORD(PEEK) {
3758   UFO_STACK(1);
3759   UFO_TOS = ufoImgGetU32(UFO_TOS);
3760 }
3761
3762 // C!
3763 // ( val8 addr -- )
3764 UFWORD(CPOKE) {
3765   UFO_STACK(2);
3766   ufoImgPutU8(UFO_TOS, UFO_S(1));
3767   ufoSP -= 2u;
3768 }
3769
3770 // W!
3771 // ( val16 addr -- )
3772 UFWORD(WPOKE) {
3773   UFO_STACK(2);
3774   ufoImgPutU16(UFO_TOS, UFO_S(1));
3775   ufoSP -= 2u;
3776 }
3777
3778 // !
3779 // ( val32 addr -- )
3780 UFWORD(POKE) {
3781   UFO_STACK(2);
3782   ufoImgPutU32(UFO_TOS, UFO_S(1));
3783   ufoSP -= 2u;
3784 }
3785
3786 // (DIRECT:@)
3787 // ( -- value32 )
3788 // code arg is address
3789 UFWORD(DIRECT_PEEK) {
3790   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3791   ufoPush(ufoImgGetU32(addr));
3792 }
3793
3794 // (DIRECT:0:!)
3795 // ( -- )
3796 // code arg is address
3797 UFWORD(DIRECT_POKE0) {
3798   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3799   ufoImgPutU32(addr, 0);
3800 }
3801
3802 // (DIRECT:1:!)
3803 // ( -- )
3804 // code arg is address
3805 UFWORD(DIRECT_POKE1) {
3806   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3807   ufoImgPutU32(addr, 1);
3808 }
3809
3810 // (DIRECT:-1:!)
3811 // ( -- )
3812 // code arg is address
3813 UFWORD(DIRECT_POKEM1) {
3814   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3815   ufoImgPutU32(addr, ~(uint32_t)0);
3816 }
3817
3818 // (DIRECT:!)
3819 // ( value32 -- )
3820 // code arg is address
3821 UFWORD(DIRECT_POKE) {
3822   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3823   const uint32_t val = ufoPop();
3824   ufoImgPutU32(addr, val);
3825 }
3826
3827 // (DIRECT:+!)
3828 // ( value32 -- )
3829 // code arg is address
3830 UFWORD(DIRECT_ADD_POKE) {
3831   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3832   uint32_t val = ufoPop();
3833   val += ufoImgGetU32(addr);
3834   ufoImgPutU32(addr, val);
3835 }
3836
3837 // (DIRECT:-!)
3838 // ( value32 -- )
3839 // code arg is address
3840 UFWORD(DIRECT_SUB_POKE) {
3841   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3842   uint32_t val = ufoPop();
3843   val -= ufoImgGetU32(addr);
3844   ufoImgPutU32(addr, val);
3845 }
3846
3847 // (DIRECT:+:@)
3848 // ( addr -- value32 )
3849 // code arg is offset
3850 UFWORD(DIRECT_OFS_PEEK) {
3851   UFO_STACK(1);
3852   const uint32_t addr = UFO_TOS + ufoImgGetU32(ufoIP); ufoIP += 4u;
3853   UFO_TOS = ufoImgGetU32(addr);
3854 }
3855
3856 // (DIRECT:+:!)
3857 // ( value32 addr -- )
3858 // code arg is offset
3859 UFWORD(DIRECT_OFS_POKE) {
3860   UFO_STACK(2);
3861   const uint32_t addr = UFO_TOS + ufoImgGetU32(ufoIP); ufoIP += 4u;
3862   ufoImgPutU32(addr, UFO_S(1));
3863   ufoSP -= 2u;
3864 }
3865
3866 // (DIRECT:1+!)
3867 // ( -- )
3868 // code arg is address
3869 UFWORD(DIRECT_POKE_INC1) {
3870   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3871   const uint32_t val = ufoImgGetU32(addr);
3872   ufoImgPutU32(addr, val + 1u);
3873 }
3874
3875 // (DIRECT:2+!)
3876 // ( -- )
3877 // code arg is address
3878 UFWORD(DIRECT_POKE_INC2) {
3879   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3880   const uint32_t val = ufoImgGetU32(addr);
3881   ufoImgPutU32(addr, val + 2u);
3882 }
3883
3884 // (DIRECT:4+!)
3885 // ( -- )
3886 // code arg is address
3887 UFWORD(DIRECT_POKE_INC4) {
3888   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3889   const uint32_t val = ufoImgGetU32(addr);
3890   ufoImgPutU32(addr, val + 4u);
3891 }
3892
3893 // (DIRECT:8+!)
3894 // ( -- )
3895 // code arg is address
3896 UFWORD(DIRECT_POKE_INC8) {
3897   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3898   const uint32_t val = ufoImgGetU32(addr);
3899   ufoImgPutU32(addr, val + 8u);
3900 }
3901
3902 // (DIRECT:1-!)
3903 // ( -- )
3904 // code arg is address
3905 UFWORD(DIRECT_POKE_DEC1) {
3906   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3907   const uint32_t val = ufoImgGetU32(addr);
3908   ufoImgPutU32(addr, val - 1u);
3909 }
3910
3911 // (DIRECT:2-!)
3912 // ( -- )
3913 // code arg is address
3914 UFWORD(DIRECT_POKE_DEC2) {
3915   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3916   const uint32_t val = ufoImgGetU32(addr);
3917   ufoImgPutU32(addr, val - 2u);
3918 }
3919
3920 // (DIRECT:4-!)
3921 // ( -- )
3922 // code arg is address
3923 UFWORD(DIRECT_POKE_DEC4) {
3924   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3925   const uint32_t val = ufoImgGetU32(addr);
3926   ufoImgPutU32(addr, val - 4u);
3927 }
3928
3929 // (DIRECT:8-!)
3930 // ( -- )
3931 // code arg is address
3932 UFWORD(DIRECT_POKE_DEC8) {
3933   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3934   const uint32_t val = ufoImgGetU32(addr);
3935   ufoImgPutU32(addr, val - 8u);
3936 }
3937
3938 // SWAP-C!
3939 // ( addr value -- )
3940 UFWORD(SWAP_CPOKE) {
3941   UFO_STACK(2);
3942   ufoImgPutU8(UFO_S(1), UFO_TOS);
3943   ufoSP -= 2u;
3944 }
3945
3946 // SWAP-W!
3947 // ( addr value -- )
3948 UFWORD(SWAP_WPOKE) {
3949   UFO_STACK(2);
3950   ufoImgPutU16(UFO_S(1), UFO_TOS);
3951   ufoSP -= 2u;
3952 }
3953
3954 // SWAP!
3955 // ( addr value -- )
3956 UFWORD(SWAP_POKE) {
3957   UFO_STACK(2);
3958   ufoImgPutU32(UFO_S(1), UFO_TOS);
3959   ufoSP -= 2u;
3960 }
3961
3962 // OR-C!
3963 // ( value addr -- )
3964 UFWORD(OR_CPOKE) {
3965   UFO_STACK(2);
3966   ufoImgPutU8(UFO_TOS, UFO_S(1) | ufoImgGetU8(UFO_TOS));
3967   ufoSP -= 2u;
3968 }
3969
3970 // OR-W!
3971 // ( value addr -- )
3972 UFWORD(OR_WPOKE) {
3973   UFO_STACK(2);
3974   ufoImgPutU16(UFO_TOS, UFO_S(1) | ufoImgGetU16(UFO_TOS));
3975   ufoSP -= 2u;
3976 }
3977
3978 // OR!
3979 // ( value addr -- )
3980 UFWORD(OR_POKE) {
3981   UFO_STACK(2);
3982   #ifdef UFO_FAST_MEM_ACCESS
3983   if ((UFO_TOS & UFO_ADDR_HANDLE_BIT) == 0) {
3984     uint32_t *uptr = ufoImgIOPtrU32(UFO_TOS);
3985     *uptr |= UFO_S(1);
3986   } else {
3987     ufoImgPutU32(UFO_TOS, UFO_S(1) | ufoImgGetU32(UFO_TOS));
3988   }
3989   #else
3990   ufoImgPutU32(UFO_TOS, UFO_S(1) | ufoImgGetU32(UFO_TOS));
3991   #endif
3992   ufoSP -= 2u;
3993 }
3994
3995 // XOR-C!
3996 // ( value addr -- )
3997 UFWORD(XOR_CPOKE) {
3998   UFO_STACK(2);
3999   ufoImgPutU8(UFO_TOS, UFO_S(1) ^ ufoImgGetU8(UFO_TOS));
4000   ufoSP -= 2u;
4001 }
4002
4003 // XOR-W!
4004 // ( value addr -- )
4005 UFWORD(XOR_WPOKE) {
4006   UFO_STACK(2);
4007   ufoImgPutU16(UFO_TOS, UFO_S(1) ^ ufoImgGetU16(UFO_TOS));
4008   ufoSP -= 2u;
4009 }
4010
4011 // XOR!
4012 // ( value addr -- )
4013 UFWORD(XOR_POKE) {
4014   UFO_STACK(2);
4015   #ifdef UFO_FAST_MEM_ACCESS
4016   if ((UFO_TOS & UFO_ADDR_HANDLE_BIT) == 0) {
4017     uint32_t *uptr = ufoImgIOPtrU32(UFO_TOS);
4018     *uptr ^= UFO_S(1);
4019   } else {
4020     ufoImgPutU32(UFO_TOS, UFO_S(1) ^ ufoImgGetU32(UFO_TOS));
4021   }
4022   #else
4023   ufoImgPutU32(UFO_TOS, UFO_S(1) ^ ufoImgGetU32(UFO_TOS));
4024   #endif
4025   ufoSP -= 2u;
4026 }
4027
4028 // ~AND-C!
4029 // ( value addr -- )
4030 UFWORD(NAND_CPOKE) {
4031   UFO_STACK(2);
4032   ufoImgPutU8(UFO_TOS, ufoImgGetU8(UFO_TOS) & ~UFO_S(1));
4033   ufoSP -= 2u;
4034 }
4035
4036 // ~AND-W!
4037 // ( value addr -- )
4038 UFWORD(NAND_WPOKE) {
4039   UFO_STACK(2);
4040   ufoImgPutU16(UFO_TOS, ufoImgGetU16(UFO_TOS) & ~UFO_S(1));
4041   ufoSP -= 2u;
4042 }
4043
4044 // ~AND!
4045 // ( value addr -- )
4046 UFWORD(NAND_POKE) {
4047   UFO_STACK(2);
4048   #ifdef UFO_FAST_MEM_ACCESS
4049   if ((UFO_TOS & UFO_ADDR_HANDLE_BIT) == 0) {
4050     uint32_t *uptr = ufoImgIOPtrU32(UFO_TOS);
4051     *uptr = *uptr & ~UFO_S(1);
4052   } else {
4053     ufoImgPutU32(UFO_TOS, ufoImgGetU32(UFO_TOS) & ~UFO_S(1));
4054   }
4055   #else
4056   ufoImgPutU32(UFO_TOS, ufoImgGetU32(UFO_TOS) & ~UFO_S(1));
4057   #endif
4058   ufoSP -= 2u;
4059 }
4060
4061 // COUNT
4062 // ( addr -- addr+4 addr@ )
4063 UFWORD(COUNT) {
4064   UFO_STACK(1);
4065   const uint32_t count = ufoImgGetU32(UFO_TOS);
4066   UFO_TOS += 4u;
4067   ufoPush(count);
4068 }
4069
4070 // ID-COUNT
4071 // ( addr -- addr+4 addr@&0xff )
4072 UFWORD(ID_COUNT) {
4073   UFO_STACK(1);
4074   const uint32_t count = ufoImgGetU32(UFO_TOS);
4075   UFO_TOS += 4u;
4076   ufoPush(count & 0xffU);
4077 }
4078
4079 // BCOUNT
4080 // ( addr -- addr+1 addrC@ )
4081 UFWORD(BCOUNT) {
4082   UFO_STACK(1);
4083   const uint32_t count = ufoImgGetU8(UFO_TOS);
4084   UFO_TOS += 1u;
4085   ufoPush(count);
4086 }
4087
4088 // 0!
4089 // ( addr -- )
4090 UFWORD(POKE_0) {
4091   ufoImgPutU32(ufoPop(), 0);
4092 }
4093
4094 // 1!
4095 // ( addr -- )
4096 UFWORD(POKE_1) {
4097   ufoImgPutU32(ufoPop(), 1);
4098 }
4099
4100 // 1+!
4101 // ( addr -- )
4102 UFWORD(POKE_INC_1) {
4103   const uint32_t addr = ufoPop();
4104   const uint32_t val = ufoImgGetU32(addr);
4105   ufoImgPutU32(addr, val + 1u);
4106 }
4107
4108 // 1-!
4109 // ( addr -- )
4110 UFWORD(POKE_DEC_1) {
4111   const uint32_t addr = ufoPop();
4112   const uint32_t val = ufoImgGetU32(addr);
4113   ufoImgPutU32(addr, val - 1u);
4114 }
4115
4116 // +!
4117 // ( delta addr -- )
4118 UFWORD(POKE_INC) {
4119   UFO_STACK(2);
4120   ufoImgPutU32(UFO_TOS, ufoImgGetU32(UFO_TOS) + UFO_S(1));
4121   ufoSP -= 2u;
4122 }
4123
4124 // -!
4125 // ( delta addr -- )
4126 UFWORD(POKE_DEC) {
4127   UFO_STACK(2);
4128   ufoImgPutU32(UFO_TOS, ufoImgGetU32(UFO_TOS) - UFO_S(1));
4129   ufoSP -= 2u;
4130 }
4131
4132
4133 // ////////////////////////////////////////////////////////////////////////// //
4134 // dictionary emitters
4135 //
4136
4137 // C,
4138 // ( val8 -- )
4139 UFWORD(CCOMMA) { const uint32_t val = ufoPop(); ufoImgEmitU8(val); }
4140
4141 // W,
4142 // ( val16 -- )
4143 UFWORD(WCOMMA) { const uint32_t val = ufoPop(); ufoImgEmitU16(val); }
4144
4145 // ,
4146 // ( val -- )
4147 UFWORD(COMMA) { const uint32_t val = ufoPop(); ufoImgEmitU32(val); }
4148
4149
4150 // ////////////////////////////////////////////////////////////////////////// //
4151 // literal pushers
4152 //
4153
4154 // (LIT) ( -- n )
4155 UFWORD(PAR_LIT) {
4156   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
4157   ufoPush(v);
4158 }
4159
4160 // (LITCFA) ( -- n )
4161 UFWORD(PAR_LITCFA) {
4162   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
4163   ufoPush(v);
4164 }
4165
4166 // (LITPFA) ( -- n )
4167 UFWORD(PAR_LITPFA) {
4168   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
4169   ufoPush(v);
4170 }
4171
4172 // (LITVOCID) ( -- n )
4173 UFWORD(PAR_LITVOCID) {
4174   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
4175   ufoPush(v);
4176 }
4177
4178 // (LITSTR8)
4179 UFWORD(PAR_LITSTR8) {
4180   const uint32_t count = ufoImgGetU8(ufoIP); ufoIP += 1;
4181   ufoPush(ufoIP);
4182   ufoPush(count);
4183   ufoIP += count + 1; // 1 for terminating 0
4184   ufoIP = UFO_ALIGN4(ufoIP);
4185 }
4186
4187
4188 // ////////////////////////////////////////////////////////////////////////// //
4189 // jumps, etc.
4190 //
4191
4192 #ifdef UFO_RELATIVE_BRANCH
4193 # define UFO_IP_BRANCH()  (ufoIP += ufoImgGetU32(ufoIP))
4194 #else
4195 # define UFO_IP_BRANCH()  (ufoIP = ufoImgGetU32(ufoIP))
4196 #endif
4197
4198 // (BRANCH) ( -- )
4199 UFWORD(PAR_BRANCH) {
4200   UFO_IP_BRANCH();
4201 }
4202
4203 // (TBRANCH) ( flag )
4204 UFWORD(PAR_TBRANCH) {
4205   if (ufoPop()) {
4206     UFO_IP_BRANCH();
4207   } else {
4208     ufoIP += 4u;
4209   }
4210 }
4211
4212 // (0BRANCH) ( flag )
4213 UFWORD(PAR_0BRANCH) {
4214   if (!ufoPop()) {
4215     UFO_IP_BRANCH();
4216   } else {
4217     ufoIP += 4u;
4218   }
4219 }
4220
4221 // (+0BRANCH) ( flag )
4222 UFWORD(PAR_P0BRANCH) {
4223   if ((ufoPop() & 0x80000000u) == 0) {
4224     UFO_IP_BRANCH();
4225   } else {
4226     ufoIP += 4u;
4227   }
4228 }
4229
4230 // (+BRANCH) ( flag )
4231 UFWORD(PAR_PBRANCH) {
4232   const int32_t v = (int32_t)ufoPop();
4233   if (v > 0) {
4234     UFO_IP_BRANCH();
4235   } else {
4236     ufoIP += 4u;
4237   }
4238 }
4239
4240 // (-0BRANCH) ( flag )
4241 UFWORD(PAR_M0BRANCH) {
4242   const int32_t v = (int32_t)ufoPop();
4243   if (v <= 0) {
4244     UFO_IP_BRANCH();
4245   } else {
4246     ufoIP += 4u;
4247   }
4248 }
4249
4250 // (-BRANCH) ( flag )
4251 UFWORD(PAR_MBRANCH) {
4252   if ((ufoPop() & 0x80000000u) != 0) {
4253     UFO_IP_BRANCH();
4254   } else {
4255     ufoIP += 4u;
4256   }
4257 }
4258
4259 // (DATASKIP) ( -- )
4260 UFWORD(PAR_DATASKIP) {
4261   ufoIP += UFO_ALIGN4(4u + ufoImgGetU32(ufoIP));
4262 }
4263
4264 // (OR-BRANCH)
4265 // ( !0 -- !0 ) -- jmp
4266 // ( 0 -- ) -- no jmp
4267 UFWORD(PAR_OR_BRANCH) {
4268   UFO_STACK(1);
4269   if (UFO_TOS != 0) {
4270     UFO_IP_BRANCH();
4271   } else {
4272     ufoSP -= 1u;
4273     ufoIP += 4u;
4274   }
4275 }
4276
4277 // (AND-BRANCH)
4278 // ( 0 -- 0 ) -- jmp
4279 // ( !0 -- ) -- no jmp
4280 UFWORD(PAR_AND_BRANCH) {
4281   UFO_STACK(1);
4282   if (UFO_TOS == 0) {
4283     UFO_IP_BRANCH();
4284   } else {
4285     ufoSP -= 1u;
4286     ufoIP += 4u;
4287   }
4288 }
4289
4290 // (?DUP-0BRANCH)
4291 // ( 0 -- ) -- jmp
4292 // ( !0 -- !0 ) -- no jmp
4293 UFWORD(PAR_QDUP_0BRANCH) {
4294   UFO_STACK(1);
4295   if (UFO_TOS != 0) {
4296     ufoIP += 4u;
4297   } else {
4298     ufoSP -= 1u;
4299     UFO_IP_BRANCH();
4300   }
4301 }
4302
4303 // (CASE-BRANCH)
4304 // ( 0 -- ) -- jmp
4305 // ( n !0 -- ) -- no jmp
4306 UFWORD(PAR_CASE_BRANCH) {
4307   UFO_STACK(2);
4308   if (UFO_TOS == 0) {
4309     ufoSP -= 1u;
4310     UFO_IP_BRANCH();
4311   } else {
4312     ufoSP -= 2u;
4313     ufoIP += 4u;
4314   }
4315 }
4316
4317
4318 // ////////////////////////////////////////////////////////////////////////// //
4319 // execute words by CFA
4320 //
4321
4322 // EXECUTE ( cfa )
4323 UFWORD(EXECUTE) {
4324   UFO_EXEC_CFA(ufoPop());
4325 }
4326
4327 // EXECUTE-TAIL ( cfa )
4328 UFWORD(EXECUTE_TAIL) {
4329   if (ufoRP != 0) ufoIP = ufoRPop();
4330   UFO_EXEC_CFA(ufoPop());
4331 }
4332
4333 // @EXECUTE ( addr )
4334 UFWORD(LOAD_EXECUTE) {
4335   const uint32_t addr = ufoPop();
4336   UFO_EXEC_CFA(ufoImgGetU32(addr));
4337 }
4338
4339 // @EXECUTE-TAIL ( cfa )
4340 UFWORD(LOAD_EXECUTE_TAIL) {
4341   if (ufoRP != 0) ufoIP = ufoRPop();
4342   const uint32_t addr = ufoPop();
4343   UFO_EXEC_CFA(ufoImgGetU32(addr));
4344 }
4345
4346 // (FORTH-CALL) ( pfa )
4347 UFWORD(FORTH_CALL) {
4348   ufoRPush(ufoIP);
4349   ufoIP = ufoPop();
4350 }
4351
4352 // (FORTH-TAIL-CALL) ( pfa )
4353 UFWORD(FORTH_TAIL_CALL) {
4354   ufoIP = ufoPop();
4355 }
4356
4357
4358 // ////////////////////////////////////////////////////////////////////////// //
4359 // word termination, locals support
4360 //
4361
4362 // (EXIT)
4363 UFWORD(PAR_EXIT) {
4364   if (ufoRP == 0) longjmp(ufoStopVMJP, 667);
4365   ufoRP -= 1u;
4366   ufoIP = ufoRStack[ufoRP];
4367   //ufoIP = ufoRPop();
4368 }
4369
4370 // (SELF@)
4371 // ( -- self-value )
4372 UFWORD(PAR_SELF_LOAD) {
4373   ufoPush(ufoImgGetU32(ufoAddrSelf));
4374 }
4375
4376 // (SELF!)
4377 // ( self-value -- )
4378 UFWORD(PAR_SELF_STORE) {
4379   const uint32_t val = ufoPop();
4380   ufoImgPutU32(ufoAddrSelf, val);
4381 }
4382
4383 // (L-ENTER)
4384 // ( loccount -- )
4385 UFWORD(PAR_LENTER) {
4386   // low byte of loccount is total number of locals
4387   // high byte is the number of args
4388   uint32_t lcount = ufoImgGetU32(ufoIP); ufoIP += 4u;
4389   uint32_t acount = (lcount >> 8) & 0xff;
4390   lcount &= 0xff;
4391   if (lcount == 0 || lcount < acount) ufoFatal("invalid call to (L-ENTER)");
4392   if ((ufoLBP != 0 && ufoLBP >= ufoLP) || UFO_LSTACK_SIZE - ufoLP <= lcount + 2) {
4393     ufoFatal("out of locals stack");
4394   }
4395   uint32_t newbp;
4396   if (ufoLP == 0) { ufoLP = 1; newbp = 1; } else newbp = ufoLP;
4397   //fprintf(stderr, "LP: %u; LBP: %u; locs: %u; word: %s\n", ufoLP, ufoLBP, fw->locs, fw->name);
4398   ufoLStack[ufoLP] = ufoLBP; ufoLP += 1;
4399   ufoLBP = newbp; ufoLP += lcount;
4400   // and copy args
4401   newbp += acount;
4402   while (newbp != ufoLBP) {
4403     ufoLStack[newbp] = ufoPop();
4404     newbp -= 1;
4405   }
4406 }
4407
4408 // (L-LEAVE)
4409 UFWORD(PAR_LLEAVE) {
4410   if (ufoLBP == 0) ufoFatal("(L-LEAVE) with empty locals stack");
4411   if (ufoLBP >= ufoLP) ufoFatal("(L-LEAVE) broken locals stack");
4412   ufoLP = ufoLBP;
4413   ufoLBP = ufoLStack[ufoLBP];
4414 }
4415
4416 //==========================================================================
4417 //
4418 //  ufoLoadLocal
4419 //
4420 //==========================================================================
4421 UFO_FORCE_INLINE void ufoLoadLocal (const uint32_t lidx) {
4422   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index");
4423   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
4424   ufoPush(ufoLStack[ufoLBP + lidx]);
4425 }
4426
4427 //==========================================================================
4428 //
4429 //  ufoStoreLocal
4430 //
4431 //==========================================================================
4432 UFO_FORCE_INLINE void ufoStoreLocal (const uint32_t lidx) {
4433   const uint32_t value = ufoPop();
4434   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index");
4435   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
4436   ufoLStack[ufoLBP + lidx] = value;
4437 }
4438
4439 // (LOCAL@)
4440 // ( idx -- value )
4441 UFWORD(PAR_LOCAL_LOAD) { ufoLoadLocal(ufoPop()); }
4442
4443 // (LOCAL!)
4444 // ( value idx -- )
4445 UFWORD(PAR_LOCAL_STORE) { ufoStoreLocal(ufoPop()); }
4446
4447
4448 // ////////////////////////////////////////////////////////////////////////// //
4449 // stack manipulation
4450 //
4451
4452 // DUP
4453 // ( n -- n n )
4454 UFWORD(DUP) { ufoDup(); }
4455 // NIP
4456 // ( a b -- b )
4457 UFWORD(NIP) {
4458   UFO_STACK(2);
4459   const uint32_t b = UFO_TOS;
4460   ufoSP -= 1;
4461   UFO_TOS = b;
4462 }
4463 // TUCK
4464 // ( a b -- b a b )
4465 UFWORD(TUCK) {
4466   const uint32_t b = ufoPop();
4467   const uint32_t a = ufoPop();
4468   ufoPush(b); ufoPush(a); ufoPush(b);
4469 }
4470 // ?DUP
4471 // ( n -- n n ) | ( 0 -- 0 )
4472 UFWORD(QDUP) {
4473   UFO_STACK(1);
4474   const uint32_t n = UFO_TOS;
4475   if (n) ufoPush(n);
4476 }
4477 // 2DUP
4478 // ( n0 n1 -- n0 n1 n0 n1 )
4479 UFWORD(DDUP) { ufo2Dup(); }
4480 // DROP
4481 // ( n -- )
4482 UFWORD(DROP) { ufoDrop(); }
4483 // 2DROP
4484 // ( n0 n1 -- )
4485 UFWORD(DDROP) { ufo2Drop(); }
4486 // SWAP
4487 // ( n0 n1 -- n1 n0 )
4488 UFWORD(SWAP) { ufoSwap(); }
4489 // 2SWAP
4490 // ( n0 n1 -- n1 n0 )
4491 UFWORD(DSWAP) { ufo2Swap(); }
4492 // OVER
4493 // ( n0 n1 -- n0 n1 n0 )
4494 UFWORD(OVER) { ufoOver(); }
4495 // 2OVER
4496 // ( n0 n1 -- n0 n1 n0 )
4497 UFWORD(DOVER) { ufo2Over(); }
4498 // ROT
4499 // ( n0 n1 n2 -- n1 n2 n0 )
4500 UFWORD(ROT) { ufoRot(); }
4501 // NROT
4502 // ( n0 n1 n2 -- n2 n0 n1 )
4503 UFWORD(NROT) { ufoNRot(); }
4504
4505 // RDUP
4506 // ( n -- n n )
4507 UFWORD(RDUP) { ufoRDup(); }
4508 // RDROP
4509 // ( n -- )
4510 UFWORD(RDROP) { ufoRDrop(); }
4511
4512 // >R
4513 // ( n -- | n )
4514 UFWORD(DTOR) { ufoRPush(ufoPop()); }
4515 // R>
4516 // ( | n -- n )
4517 UFWORD(RTOD) { ufoPush(ufoRPop()); }
4518 // R@
4519 // ( | n -- n | n )
4520 UFWORD(RPEEK) { ufoPush(ufoRPeek()); }
4521 // 2RDROP
4522 // ( | n n -- )
4523 UFWORD(2RDROP) {
4524   UFO_RSTACK(2);
4525   ufoRP -= 2u;
4526 }
4527 // 2>R
4528 // ( a b | -- | a b )
4529 UFWORD(2DTOR) {
4530   const uint32_t b = ufoPop();
4531   const uint32_t a = ufoPop();
4532   ufoRPush(a);
4533   ufoRPush(b);
4534 }
4535 // 2R>
4536 // ( | a b -- a b | )
4537 UFWORD(2RTOD) {
4538   const uint32_t b = ufoRPop();
4539   const uint32_t a = ufoRPop();
4540   ufoPush(a);
4541   ufoPush(b);
4542 }
4543 // 2R@
4544 // ( | a b -- a b | a b )
4545 UFWORD(2RPEEK) {
4546   UFO_RSTACK(2);
4547   ufoPush(UFO_R(1));
4548   ufoPush(UFO_RTOS);
4549 }
4550
4551 // PICK
4552 // ( idx -- n )
4553 UFWORD(PICK) {
4554   const uint32_t n = ufoPop();
4555   if (n >= ufoSP) ufoFatal("invalid PICK index %u", n);
4556   ufoPush(ufoDStack[ufoSP - n - 1u]);
4557 }
4558
4559 // RPICK
4560 // ( idx -- n )
4561 UFWORD(RPICK) {
4562   const uint32_t n = ufoPop();
4563   if (n >= ufoRP) ufoFatal("invalid RPICK index %u", n);
4564   const uint32_t rp = ufoRP - n - 1u;
4565   ufoPush(ufoRStack[rp]);
4566 }
4567
4568 // ROLL
4569 // ( idx -- n )
4570 UFWORD(ROLL) {
4571   const uint32_t n = ufoPop();
4572   if (n >= ufoSP) ufoFatal("invalid ROLL index %u", n);
4573   switch (n) {
4574     case 0: break; // do nothing
4575     case 1: ufoSwap(); break;
4576     case 2: ufoRot(); break;
4577     default:
4578       {
4579         const uint32_t val = ufoDStack[ufoSP - n - 1u];
4580         for (uint32_t f = ufoSP - n; f < ufoSP; f += 1) ufoDStack[f - 1] = ufoDStack[f];
4581         ufoDStack[ufoSP - 1u] = val;
4582       }
4583       break;
4584   }
4585 }
4586
4587 // RROLL
4588 // ( idx -- n )
4589 UFWORD(RROLL) {
4590   const uint32_t n = ufoPop();
4591   if (n >= ufoRP) ufoFatal("invalid RROLL index %u", n);
4592   if (n != 0) {
4593     const uint32_t rp = ufoRP - n - 1u;
4594     const uint32_t val = ufoRStack[rp];
4595     for (uint32_t f = rp + 1u; f < ufoRP; f += 1u) ufoRStack[f - 1u] = ufoRStack[f];
4596     ufoRStack[ufoRP - 1u] = val;
4597   }
4598 }
4599
4600 // RSWAP
4601 // ( | a b -- | b a )
4602 UFWORD(RSWAP) {
4603   UFO_RSTACK(2);
4604   const uint32_t b = UFO_RTOS;
4605   const uint32_t a = UFO_R(1);
4606   UFO_RTOS = a;
4607   UFO_R(1) = b;
4608 }
4609
4610 // ROVER
4611 // ( | a b -- | a b a )
4612 UFWORD(ROVER) {
4613   UFO_RSTACK(2);
4614   const uint32_t a = UFO_R(1);
4615   ufoRPush(a);
4616 }
4617
4618 // RROT
4619 // ( | a b c -- | b c a )
4620 UFWORD(RROT) {
4621   UFO_RSTACK(3);
4622   const uint32_t c = UFO_RTOS;
4623   const uint32_t b = UFO_R(1);
4624   const uint32_t a = UFO_R(2);
4625   UFO_R(2) = b;
4626   UFO_R(1) = c;
4627   UFO_RTOS = a;
4628 }
4629
4630 // RNROT
4631 // ( | a b c -- | c a b )
4632 UFWORD(RNROT) {
4633   UFO_RSTACK(3);
4634   const uint32_t c = UFO_RTOS;
4635   const uint32_t b = UFO_R(1);
4636   const uint32_t a = UFO_R(2);
4637   UFO_R(2) = c;
4638   UFO_R(1) = a;
4639   UFO_RTOS = b;
4640 }
4641
4642
4643 // ////////////////////////////////////////////////////////////////////////// //
4644 // TIB API
4645 //
4646
4647 // REFILL
4648 // ( -- eofflag )
4649 UFWORD(REFILL) {
4650   ufoPushBool(ufoLoadNextLine(1));
4651 }
4652
4653 // REFILL-NOCROSS
4654 // ( -- eofflag )
4655 UFWORD(REFILL_NOCROSS) {
4656   ufoPushBool(ufoLoadNextLine(0));
4657 }
4658
4659 // (TIB-IN)
4660 // ( -- addr )
4661 UFWORD(TIB_IN) {
4662   ufoPush(ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx));
4663 }
4664
4665 // TIB-PEEKCH
4666 // ( -- char )
4667 UFWORD(TIB_PEEKCH) {
4668   ufoPush(ufoTibPeekCh());
4669 }
4670
4671 // TIB-PEEKCH-OFS
4672 // ( ofs -- char )
4673 UFWORD(TIB_PEEKCH_OFS) {
4674   const uint32_t ofs = ufoPop();
4675   ufoPush(ufoTibPeekChOfs(ofs));
4676 }
4677
4678 // TIB-GETCH
4679 // ( -- char )
4680 UFWORD(TIB_GETCH) {
4681   ufoPush(ufoTibGetCh());
4682 }
4683
4684 // TIB-SKIPCH
4685 // ( -- )
4686 UFWORD(TIB_SKIPCH) {
4687   ufoTibSkipCh();
4688 }
4689
4690
4691 // ////////////////////////////////////////////////////////////////////////// //
4692 // TIB parsing
4693 //
4694
4695 //==========================================================================
4696 //
4697 //  ufoIsDelim
4698 //
4699 //==========================================================================
4700 UFO_FORCE_INLINE int ufoIsDelim (uint8_t ch, uint8_t delim) {
4701   return (delim == 32 ? (ch <= 32) : (ch == delim));
4702 }
4703
4704 // (PARSE)
4705 // ( delim skip-leading-delim? -- addr count TRUE / FALSE )
4706 // does base TIB parsing; never copies anything.
4707 // as our reader is line-based, returns FALSE on EOL.
4708 // EOL is detected after skipping leading delimiters.
4709 // passing -1 as delimiter skips the whole line, and always returns FALSE.
4710 // trailing delimiter is always skipped.
4711 UFWORD(PAR_PARSE) {
4712   const uint32_t skipDelim = ufoPop();
4713   const uint32_t delim = ufoPop();
4714   uint8_t ch;
4715
4716   if (delim == 0 || delim > 0xffU) {
4717     // skip everything
4718     while (ufoTibGetCh() != 0) {}
4719     ufoPushBool(0);
4720   } else {
4721     ch = ufoTibPeekCh();
4722     // skip initial delimiters
4723     if (skipDelim) {
4724       while (ch != 0 && ufoIsDelim(ch, delim)) {
4725         ufoTibSkipCh();
4726         ch = ufoTibPeekCh();
4727       }
4728     }
4729     if (ch == 0) {
4730       ufoPushBool(0);
4731     } else {
4732       // parse
4733       const uint32_t staddr = ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx);
4734       uint32_t count = 0;
4735       while (ch != 0 && !ufoIsDelim(ch, delim)) {
4736         count += 1u;
4737         ufoTibSkipCh();
4738         ch = ufoTibPeekCh();
4739       }
4740       // skip delimiter
4741       if (ch != 0) ufoTibSkipCh();
4742       ufoPush(staddr);
4743       ufoPush(count);
4744       ufoPushBool(1);
4745     }
4746   }
4747 }
4748
4749 // PARSE-SKIP-BLANKS
4750 // ( -- )
4751 UFWORD(PARSE_SKIP_BLANKS) {
4752   uint8_t ch = ufoTibPeekCh();
4753   while (ch != 0 && ch <= 32) {
4754     ufoTibSkipCh();
4755     ch = ufoTibPeekCh();
4756   }
4757 }
4758
4759 //==========================================================================
4760 //
4761 //  ufoParseMLComment
4762 //
4763 //  initial two chars are skipped
4764 //
4765 //==========================================================================
4766 static void ufoParseMLComment (uint32_t allowMulti, int nested) {
4767   uint32_t level = 1;
4768   uint8_t ch, ch1;
4769   while (level != 0) {
4770     ch = ufoTibGetCh();
4771     if (ch == 0) {
4772       if (allowMulti) {
4773         UFCALL(REFILL_NOCROSS);
4774         if (ufoPop() == 0) ufoFatal("unexpected end of file in comment");
4775       } else {
4776         ufoFatal("unexpected end of line in comment");
4777       }
4778     } else {
4779       ch1 = ufoTibPeekCh();
4780       if (nested && ch == '(' && ch1 == '(') { ufoTibSkipCh(); level += 1; }
4781       else if (nested && ch == ')' && ch1 == ')') { ufoTibSkipCh(); level -= 1; }
4782       else if (!nested && ch == '*' && ch1 == ')') { ufo_assert(level == 1); ufoTibSkipCh(); level = 0; }
4783     }
4784   }
4785 }
4786
4787 // (PARSE-SKIP-COMMENTS)
4788 // ( allow-multiline? -- )
4789 // skip all blanks and comments
4790 UFWORD(PAR_PARSE_SKIP_COMMENTS) {
4791   const uint32_t allowMulti = ufoPop();
4792   uint8_t ch, ch1;
4793   ch = ufoTibPeekCh();
4794   #if 0
4795   fprintf(stderr, "(PARSE-SKIP-COMMENTS): first-ch:'%c'\n", (char)ch);
4796   #endif
4797   while (ch != 0) {
4798     if (ch <= 32) {
4799       ufoTibSkipCh();
4800       ch = ufoTibPeekCh();
4801       #if 0
4802       fprintf(stderr, "(PARSE-SKIP-COMMENTS): blank-ch:'%c'\n", (char)ch);
4803       #endif
4804     } else if (ch == '(') {
4805       #if 0
4806       fprintf(stderr, "(PARSE-SKIP-COMMENTS): ch:'%c'; ch1:'%c' ('%c')\n", (char)ch, (char)ch1,
4807               ufoTibPeekChOfs(0));
4808       #endif
4809       ch1 = ufoTibPeekChOfs(1);
4810       if (ch1 <= 32) {
4811         // single-line comment
4812         do { ch = ufoTibGetCh(); } while (ch != 0 && ch != ')');
4813         ch = ufoTibPeekCh();
4814       } else if ((ch1 == '*' || ch1 == '(') && ufoTibPeekChOfs(2) <= 32) {
4815         // possibly multiline
4816         ufoTibSkipCh(); ufoTibSkipCh(); // skip opening
4817         ufoParseMLComment(allowMulti, (ch1 == '('));
4818         ch = ufoTibPeekCh();
4819       } else {
4820         ch = 0;
4821       }
4822     } else if (ch == '\\' && ufoTibPeekChOfs(1) <= 32) {
4823       // single-line comment
4824       while (ch != 0) ch = ufoTibGetCh();
4825     } else if (ch == '-' && ufoTibPeekChOfs(1) == ch && ufoTibPeekChOfs(2) <= 32) {
4826       // skip to EOL
4827       while (ch != 0) ch = ufoTibGetCh();
4828     } else if ((ch == ';' || ch == '/') && ufoTibPeekChOfs(1) == ch) {
4829       // skip to EOL
4830       while (ch != 0) ch = ufoTibGetCh();
4831     } else {
4832       ch = 0;
4833     }
4834   }
4835   #if 0
4836   fprintf(stderr, "(PARSE-SKIP-COMMENTS): end-ch:'%c'\n", ufoTibPeekCh());
4837   #endif
4838 }
4839
4840 // PARSE-SKIP-LINE
4841 // ( -- )
4842 UFWORD(PARSE_SKIP_LINE) {
4843   ufoPush(0); ufoPushBool(0); UFCALL(PAR_PARSE);
4844   if (ufoPop() != 0) {
4845     ufo2Drop();
4846   }
4847 }
4848
4849 // PARSE-NAME
4850 // ( -- addr count )
4851 // parse with leading blanks skipping. doesn't copy anything.
4852 // return empty string on EOL.
4853 UFWORD(PARSE_NAME) {
4854   ufoPush(32); ufoPushBool(1); UFCALL(PAR_PARSE);
4855   if (ufoPop() == 0) {
4856     ufoPush(0);
4857     ufoPush(0);
4858   }
4859 }
4860
4861 // PARSE
4862 // ( delim -- addr count TRUE / FALSE )
4863 // parse without skipping delimiters; never copies anything.
4864 // as our reader is line-based, returns FALSE on EOL.
4865 // passing 0 as delimiter skips the whole line, and always returns FALSE.
4866 // trailing delimiter is always skipped.
4867 UFWORD(PARSE) {
4868   ufoPushBool(0); UFCALL(PAR_PARSE);
4869 }
4870
4871
4872 // ////////////////////////////////////////////////////////////////////////// //
4873 // char output
4874 //
4875
4876 // (NORM-EMIT-CHAR)
4877 // ( ch -- )
4878 UFWORD(PAR_NORM_EMIT_CHAR) {
4879   uint32_t ch = ufoPop()&0xffU;
4880   if (ch < 32 || ch == 127) {
4881     if (ch != 9 && ch != 10 && ch != 13) ch = '?';
4882   }
4883   ufoPush(ch);
4884 }
4885
4886 // (NORM-XEMIT-CHAR)
4887 // ( ch -- )
4888 UFWORD(PAR_NORM_XEMIT_CHAR) {
4889   uint32_t ch = ufoPop()&0xffU;
4890   if (ch < 32 || ch == 127) ch = '?';
4891   ufoPush(ch);
4892 }
4893
4894 // (EMIT)
4895 // ( n -- )
4896 UFWORD(PAR_EMIT) {
4897   uint32_t ch = ufoPop()&0xffU;
4898   ufoLastEmitWasCR = (ch == 10);
4899   putchar((char)ch);
4900 }
4901
4902 // LASTCR?
4903 // ( -- bool )
4904 UFWORD(LASTCRQ) {
4905   ufoPushBool(ufoLastEmitWasCR);
4906 }
4907
4908 // LASTCR!
4909 // ( bool -- )
4910 UFWORD(LASTCRSET) {
4911   ufoLastEmitWasCR = !!ufoPop();
4912 }
4913
4914 // FLUSH-EMIT
4915 // ( -- )
4916 UFWORD(FLUSH_EMIT) {
4917   ufoFlushOutput();
4918 }
4919
4920
4921 // ////////////////////////////////////////////////////////////////////////// //
4922 // simple math
4923 //
4924
4925 #define UF_BMATH(name_,op_)  \
4926 UFWORD(name_) { \
4927   UFO_STACK(2); \
4928   const uint32_t b = UFO_TOS; \
4929   const uint32_t a = UFO_S(1); \
4930   ufoSP -= 1u; \
4931   UFO_TOS = (op_); \
4932 }
4933
4934 #define UF_BDIV(name_,op_)  \
4935 UFWORD(name_) { \
4936   UFO_STACK(2); \
4937   const uint32_t b = UFO_TOS; \
4938   const uint32_t a = UFO_S(1); \
4939   if (b == 0) ufoFatal("division by zero"); \
4940   ufoSP -= 1u; \
4941   UFO_TOS = (op_); \
4942 }
4943
4944 #define UFO_POP_U64()  ({ \
4945   UFO_STACK(2); \
4946   const uint32_t hi_ = UFO_TOS; \
4947   const uint32_t lo_ = UFO_S(1); \
4948   ufoSP -= 2u; \
4949   (((uint64_t)hi_ << 32) | lo_); \
4950 })
4951
4952 // this is UB by the idiotic C standard. i don't care.
4953 #define UFO_POP_I64()  ((int64_t)UFO_POP_U64())
4954
4955 #define UFO_PUSH_U64(vn_)  do { \
4956   ufoPush((uint32_t)(vn_)); \
4957   ufoPush((uint32_t)((vn_) >> 32)); \
4958 } while (0)
4959
4960 // this is UB by the idiotic C standard. i don't care.
4961 #define UFO_PUSH_I64(vn_)  UFO_PUSH_U64((uint64_t)(vn_))
4962
4963 // +
4964 // ( a b -- a+b )
4965 UF_BMATH(PLUS, a + b);
4966
4967 // -
4968 // ( a b -- a-b )
4969 UF_BMATH(MINUS, a - b);
4970
4971 // *
4972 // ( a b -- a*b )
4973 UF_BMATH(MUL, (uint32_t)((int32_t)a * (int32_t)b));
4974
4975 // U*
4976 // ( a b -- a*b )
4977 UF_BMATH(UMUL, a * b);
4978
4979 // /
4980 // ( a b -- a/b )
4981 UF_BDIV(DIV, (uint32_t)((int32_t)a / (int32_t)b));
4982
4983 // U/
4984 // ( a b -- a/b )
4985 UF_BDIV(UDIV, a / b);
4986
4987 // MOD
4988 // ( a b -- a%b )
4989 UF_BDIV(MOD, (uint32_t)((int32_t)a % (int32_t)b));
4990
4991 // UMOD
4992 // ( a b -- a%b )
4993 UF_BDIV(UMOD, a % b);
4994
4995 // /MOD
4996 // ( a b -- a/b, a%b )
4997 UFWORD(DIVMOD) {
4998   const int32_t b = (int32_t)ufoPop();
4999   const int32_t a = (int32_t)ufoPop();
5000   if (b == 0) ufoFatal("division by zero");
5001   ufoPush((uint32_t)(a/b));
5002   ufoPush((uint32_t)(a%b));
5003 }
5004
5005 // U/MOD
5006 // ( a b -- a/b, a%b )
5007 UFWORD(UDIVMOD) {
5008   const uint32_t b = ufoPop();
5009   const uint32_t a = ufoPop();
5010   if (b == 0) ufoFatal("division by zero");
5011   ufoPush((uint32_t)(a/b));
5012   ufoPush((uint32_t)(a%b));
5013 }
5014
5015 // */
5016 // ( a b c -- a*b/c )
5017 // this uses 64-bit intermediate value
5018 UFWORD(MULDIV) {
5019   const int32_t c = (int32_t)ufoPop();
5020   const int32_t b = (int32_t)ufoPop();
5021   const int32_t a = (int32_t)ufoPop();
5022   if (c == 0) ufoFatal("division by zero");
5023   int64_t xval = a; xval *= b; xval /= c;
5024   ufoPush((uint32_t)(int32_t)xval);
5025 }
5026
5027 // U*/
5028 // ( a b c -- a*b/c )
5029 // this uses 64-bit intermediate value
5030 UFWORD(UMULDIV) {
5031   const uint32_t c = ufoPop();
5032   const uint32_t b = ufoPop();
5033   const uint32_t a = ufoPop();
5034   if (c == 0) ufoFatal("division by zero");
5035   uint64_t xval = a; xval *= b; xval /= c;
5036   ufoPush((uint32_t)xval);
5037 }
5038
5039 // */MOD
5040 // ( a b c -- a*b/c a*b%c )
5041 // this uses 64-bit intermediate value
5042 UFWORD(MULDIVMOD) {
5043   const int32_t c = (int32_t)ufoPop();
5044   const int32_t b = (int32_t)ufoPop();
5045   const int32_t a = (int32_t)ufoPop();
5046   if (c == 0) ufoFatal("division by zero");
5047   int64_t xval = a; xval *= b;
5048   ufoPush((uint32_t)(int32_t)(xval / c));
5049   ufoPush((uint32_t)(int32_t)(xval % c));
5050 }
5051
5052 // U*/
5053 // ( a b c -- a*b/c )
5054 // this uses 64-bit intermediate value
5055 UFWORD(UMULDIVMOD) {
5056   const uint32_t c = ufoPop();
5057   const uint32_t b = ufoPop();
5058   const uint32_t a = ufoPop();
5059   if (c == 0) ufoFatal("division by zero");
5060   uint64_t xval = a; xval *= b;
5061   ufoPush((uint32_t)(xval / c));
5062   ufoPush((uint32_t)(xval % c));
5063 }
5064
5065 // M*
5066 // ( a b -- lo(a*b) hi(a*b) )
5067 // this leaves 64-bit result
5068 UFWORD(MMUL) {
5069   const int32_t b = (int32_t)ufoPop();
5070   const int32_t a = (int32_t)ufoPop();
5071   int64_t xval = a; xval *= b;
5072   UFO_PUSH_I64(xval);
5073 }
5074
5075 // UM*
5076 // ( a b -- lo(a*b) hi(a*b) )
5077 // this leaves 64-bit result
5078 UFWORD(UMMUL) {
5079   const uint32_t b = ufoPop();
5080   const uint32_t a = ufoPop();
5081   uint64_t xval = a; xval *= b;
5082   UFO_PUSH_U64(xval);
5083 }
5084
5085 // M/MOD
5086 // ( alo ahi b -- a/b a%b )
5087 UFWORD(MDIVMOD) {
5088   const int32_t b = (int32_t)ufoPop();
5089   if (b == 0) ufoFatal("division by zero");
5090   int64_t a = UFO_POP_I64();
5091   int32_t adiv = (int32_t)(a / b);
5092   int32_t amod = (int32_t)(a % b);
5093   ufoPush((uint32_t)adiv);
5094   ufoPush((uint32_t)amod);
5095 }
5096
5097 // UM/MOD
5098 // ( alo ahi b -- a/b a%b )
5099 UFWORD(UMDIVMOD) {
5100   const uint32_t b = ufoPop();
5101   if (b == 0) ufoFatal("division by zero");
5102   uint64_t a = UFO_POP_U64();
5103   uint32_t adiv = (uint32_t)(a / b);
5104   uint32_t amod = (uint32_t)(a % b);
5105   ufoPush(adiv);
5106   ufoPush(amod);
5107 }
5108
5109 // UDS*
5110 // ( alo ahi u -- lo hi )
5111 UFWORD(UDSMUL) {
5112   const uint32_t b = ufoPop();
5113   uint64_t a = UFO_POP_U64();
5114   a *= b;
5115   UFO_PUSH_U64(a);
5116 }
5117
5118 // D-
5119 // ( lo0 hi0 lo1 hi1 -- lo hi )
5120 UFWORD(DMINUS) {
5121   uint64_t n1 = UFO_POP_U64();
5122   uint64_t n0 = UFO_POP_U64();
5123   n0 -= n1;
5124   UFO_PUSH_U64(n0);
5125 }
5126
5127 // D+
5128 // ( lo0 hi0 lo1 hi1 -- lo hi )
5129 UFWORD(DPLUS) {
5130   uint64_t n1 = UFO_POP_U64();
5131   uint64_t n0 = UFO_POP_U64();
5132   n0 += n1;
5133   UFO_PUSH_U64(n0);
5134 }
5135
5136 // D=
5137 // ( lo0 hi0 lo1 hi1 -- bool )
5138 UFWORD(DEQU) {
5139   uint64_t n1 = UFO_POP_U64();
5140   uint64_t n0 = UFO_POP_U64();
5141   ufoPushBool(n0 == n1);
5142 }
5143
5144 // D<
5145 // ( lo0 hi0 lo1 hi1 -- bool )
5146 UFWORD(DLESS) {
5147   int64_t n1 = UFO_POP_I64();
5148   int64_t n0 = UFO_POP_I64();
5149   ufoPushBool(n0 < n1);
5150 }
5151
5152 // D<=
5153 // ( lo0 hi0 lo1 hi1 -- bool )
5154 UFWORD(DLESSEQU) {
5155   int64_t n1 = UFO_POP_I64();
5156   int64_t n0 = UFO_POP_I64();
5157   ufoPushBool(n0 <= n1);
5158 }
5159
5160 // DU<
5161 // ( lo0 hi0 lo1 hi1 -- bool )
5162 UFWORD(DULESS) {
5163   uint64_t n1 = UFO_POP_U64();
5164   uint64_t n0 = UFO_POP_U64();
5165   ufoPushBool(n0 < n1);
5166 }
5167
5168 // DU<=
5169 // ( lo0 hi0 lo1 hi1 -- bool )
5170 UFWORD(DULESSEQU) {
5171   uint64_t n1 = UFO_POP_U64();
5172   uint64_t n0 = UFO_POP_U64();
5173   ufoPushBool(n0 <= n1);
5174 }
5175
5176 // SM/REM
5177 // ( dlo dhi n -- nmod ndiv )
5178 // rounds toward zero
5179 UFWORD(SMREM) {
5180   const int32_t n = (int32_t)ufoPop();
5181   if (n == 0) ufoFatal("division by zero");
5182   int64_t d = UFO_POP_I64();
5183   int32_t ndiv = (int32_t)(d / n);
5184   int32_t nmod = (int32_t)(d % n);
5185   ufoPush(nmod);
5186   ufoPush(ndiv);
5187 }
5188
5189 // FM/MOD
5190 // ( dlo dhi n -- nmod ndiv )
5191 // rounds toward negative infinity
5192 UFWORD(FMMOD) {
5193   const int32_t n = (int32_t)ufoPop();
5194   if (n == 0) ufoFatal("division by zero");
5195   int64_t d = UFO_POP_I64();
5196   int32_t ndiv = (int32_t)(d / n);
5197   int32_t nmod = (int32_t)(d % n);
5198   if (nmod != 0 && ((uint32_t)n ^ (uint32_t)(d >> 32)) >= 0x80000000u) {
5199     ndiv -= 1;
5200     nmod += n;
5201   }
5202   ufoPush(nmod);
5203   ufoPush(ndiv);
5204 }
5205
5206
5207 // ////////////////////////////////////////////////////////////////////////// //
5208 // simple logic and bit manipulation
5209 //
5210
5211 #define UF_CMP(name_,op_)  \
5212 UFWORD(name_) { \
5213   const uint32_t b = ufoPop(); \
5214   const uint32_t a = ufoPop(); \
5215   ufoPushBool(op_); \
5216 }
5217
5218 // <
5219 // ( a b -- a<b )
5220 UF_CMP(LESS, (int32_t)a < (int32_t)b);
5221
5222 // U<
5223 // ( a b -- a<b )
5224 UF_CMP(ULESS, a < b);
5225
5226 // >
5227 // ( a b -- a>b )
5228 UF_CMP(GREAT, (int32_t)a > (int32_t)b);
5229
5230 // U>
5231 // ( a b -- a>b )
5232 UF_CMP(UGREAT, a > b);
5233
5234 // <=
5235 // ( a b -- a<=b )
5236 UF_CMP(LESSEQU, (int32_t)a <= (int32_t)b);
5237
5238 // U<=
5239 // ( a b -- a<=b )
5240 UF_CMP(ULESSEQU, a <= b);
5241
5242 // >=
5243 // ( a b -- a>=b )
5244 UF_CMP(GREATEQU, (int32_t)a >= (int32_t)b);
5245
5246 // U>=
5247 // ( a b -- a>=b )
5248 UF_CMP(UGREATEQU, a >= b);
5249
5250 // =
5251 // ( a b -- a=b )
5252 UF_CMP(EQU, a == b);
5253
5254 // <>
5255 // ( a b -- a<>b )
5256 UF_CMP(NOTEQU, a != b);
5257
5258 // 0=
5259 // ( a -- a==0 )
5260 UFWORD(ZERO_EQU) {
5261   const uint32_t a = ufoPop();
5262   ufoPushBool(a == 0);
5263 }
5264
5265 // 0<>
5266 // ( a -- a<>0 )
5267 UFWORD(ZERO_NOTEQU) {
5268   const uint32_t a = ufoPop();
5269   ufoPushBool(a != 0);
5270 }
5271
5272 // LAND
5273 // ( a b -- a&&b )
5274 UF_CMP(LOGAND, a && b);
5275
5276 // LOR
5277 // ( a b -- a||b )
5278 UF_CMP(LOGOR, a || b);
5279
5280 // AND
5281 // ( a b -- a&b )
5282 UFWORD(AND) {
5283   const uint32_t b = ufoPop();
5284   const uint32_t a = ufoPop();
5285   ufoPush(a&b);
5286 }
5287
5288 // OR
5289 // ( a b -- a|b )
5290 UFWORD(OR) {
5291   const uint32_t b = ufoPop();
5292   const uint32_t a = ufoPop();
5293   ufoPush(a|b);
5294 }
5295
5296 // XOR
5297 // ( a b -- a^b )
5298 UFWORD(XOR) {
5299   const uint32_t b = ufoPop();
5300   const uint32_t a = ufoPop();
5301   ufoPush(a^b);
5302 }
5303
5304 // (LIT-AND)
5305 // ( a -- a&[ip] )
5306 UFWORD(LIT_AND) {
5307   UFO_STACK(1);
5308   UFO_TOS &= ufoImgGetU32(ufoIP); ufoIP += 4u;
5309 }
5310
5311 // (LIT-~AND)
5312 // ( a -- a&~[ip] )
5313 UFWORD(LIT_NAND) {
5314   UFO_STACK(1);
5315   UFO_TOS &= ~ufoImgGetU32(ufoIP); ufoIP += 4u;
5316 }
5317
5318 // (LIT-OR)
5319 // ( a -- a|[ip] )
5320 UFWORD(LIT_OR) {
5321   UFO_STACK(1);
5322   UFO_TOS |= ufoImgGetU32(ufoIP); ufoIP += 4u;
5323 }
5324
5325 // (LIT-XOR)
5326 // ( a -- a^[ip] )
5327 UFWORD(LIT_XOR) {
5328   UFO_STACK(1);
5329   UFO_TOS ^= ufoImgGetU32(ufoIP); ufoIP += 4u;
5330 }
5331
5332
5333 // BITNOT
5334 // ( a -- ~a )
5335 UFWORD(BITNOT) {
5336   const uint32_t a = ufoPop();
5337   ufoPush(~a);
5338 }
5339
5340 // ASH
5341 // ( n count -- )
5342 // arithmetic shift; positive `n` shifts to the left
5343 UFWORD(ASH) {
5344   int32_t c = (int32_t)ufoPop();
5345   if (c < 0) {
5346     // right
5347     int32_t n = (int32_t)ufoPop();
5348     if (c >= -30) {
5349       n >>= (uint8_t)(-c);
5350     } else {
5351       if (n < 0) n = -1; else n = 0;
5352     }
5353     ufoPush((uint32_t)n);
5354   } else if (c > 0) {
5355     // left
5356     uint32_t u = ufoPop();
5357     if (c <= 31) {
5358       u <<= (uint8_t)c;
5359     } else {
5360       u = 0;
5361     }
5362     ufoPush(u);
5363   }
5364 }
5365
5366 // LSH
5367 // ( n count -- )
5368 // logical shift; positive `n` shifts to the left
5369 UFWORD(LSH) {
5370   int32_t c = (int32_t) ufoPop();
5371   uint32_t u = ufoPop();
5372   if (c < 0) {
5373     // right
5374     if (c >= -31) {
5375       u >>= (uint8_t)(-c);
5376     } else {
5377       u = 0;
5378     }
5379   } else if (c > 0) {
5380     // left
5381     if (c <= 31) {
5382       u <<= (uint8_t)c;
5383     } else {
5384       u = 0;
5385     }
5386   }
5387   ufoPush(u);
5388 }
5389
5390 // ARSHIFT
5391 // ( n count -- )
5392 // arithmetic shift right
5393 UFWORD(ARSHIFT) {
5394   int32_t c = (int32_t)ufoPop();
5395   if (c >= 0) {
5396     int32_t n = (int32_t)ufoPop();
5397     if (c <= 30) {
5398       n >>= (uint8_t)(c);
5399     } else {
5400       if (n < 0) n = -1; else n = 0;
5401     }
5402     ufoPush((uint32_t)n);
5403   } else {
5404     ufoFatal("negative shift");
5405   }
5406 }
5407
5408 // RSHIFT
5409 // ( n count -- )
5410 // logical shift right
5411 UFWORD(RSHIFT) {
5412   uint32_t c = (int32_t)ufoPop();
5413   if (c >= 0) {
5414     uint32_t n = (int32_t)ufoPop();
5415     if (c <= 31) {
5416       n >>= (uint8_t)(c);
5417     } else {
5418       n = 0;
5419     }
5420     ufoPush((uint32_t)n);
5421   } else {
5422     ufoFatal("negative shift");
5423   }
5424 }
5425
5426 // LSHIFT
5427 // ( n count -- )
5428 // logical shift left
5429 UFWORD(LSHIFT) {
5430   int32_t c = (int32_t) ufoPop();
5431   uint32_t u = ufoPop();
5432   if (c >= 0) {
5433     if (c <= 31) {
5434       u <<= (uint8_t)c;
5435     } else {
5436       u = 0;
5437     }
5438     ufoPush(u);
5439   } else {
5440     ufoFatal("negative shift");
5441   }
5442 }
5443
5444 // ~AND
5445 // ( a b -- a&~b )
5446 UFWORD(BN_AND) {
5447   const uint32_t b = ufoPop();
5448   const uint32_t a = ufoPop();
5449   ufoPush(a&~b);
5450 }
5451
5452 // ABS
5453 // ( a -- |a| )
5454 UFWORD(ABS) {
5455   if ((ufoPeek() & 0x80000000) != 0) {
5456     UFO_TOS = ~UFO_TOS + 1u;
5457   }
5458 }
5459
5460 // NEGATE
5461 // ( a -- -a )
5462 UFWORD(NEGATE) {
5463   UFO_STACK(1);
5464   UFO_TOS = ~UFO_TOS + 1u;
5465 }
5466
5467 // SIGN?
5468 // ( n -- -1|0|1 )
5469 UFWORD(SIGNQ) {
5470   const uint32_t a = ufoPop();
5471   if ((a & 0x80000000) != 0) ufoPush(~(uint32_t)0);
5472   else if (a != 0) ufoPush(1);
5473   else ufoPush(0);
5474 }
5475
5476 // LO-WORD
5477 // ( a -- a&0xffff )
5478 UFWORD(LO_WORD) {
5479   UFO_STACK(1);
5480   UFO_TOS &= 0xffffU;
5481 }
5482
5483 // LO-BYTE
5484 // ( a -- a&0xff )
5485 UFWORD(LO_BYTE) {
5486   UFO_STACK(1);
5487   UFO_TOS &= 0xffU;
5488 }
5489
5490 // HI-WORD
5491 // ( a -- (a>>16)&0xffff )
5492 UFWORD(HI_WORD) {
5493   UFO_STACK(1);
5494   UFO_TOS = (UFO_TOS>>16)&0xffffU;
5495 }
5496
5497 // HI-BYTE
5498 // ( a -- (a>>8)&0xff )
5499 UFWORD(HI_BYTE) {
5500   UFO_STACK(1);
5501   UFO_TOS = (UFO_TOS>>8)&0xffU;
5502 }
5503
5504 // MIN
5505 // ( a b -- min[a,b] )
5506 UFWORD(MIN) {
5507   const int32_t b = (int32_t)ufoPop();
5508   UFO_STACK(1);
5509   if ((int32_t)UFO_TOS > b) UFO_TOS = (uint32_t)b;
5510 }
5511
5512 // MAX
5513 // ( a b -- max[a,b] )
5514 UFWORD(MAX) {
5515   const int32_t b = (int32_t)ufoPop();
5516   UFO_STACK(1);
5517   if ((int32_t)UFO_TOS < b) UFO_TOS = (uint32_t)b;
5518 }
5519
5520 // UMIN
5521 // ( a b -- umin[a,b] )
5522 UFWORD(UMIN) {
5523   const uint32_t b = ufoPop();
5524   UFO_STACK(1);
5525   if (UFO_TOS > b) UFO_TOS = b;
5526 }
5527
5528 // UMAX
5529 // ( a b -- umax[a,b] )
5530 UFWORD(UMAX) {
5531   const uint32_t b = ufoPop();
5532   UFO_STACK(1);
5533   if (UFO_TOS < b) UFO_TOS = b;
5534 }
5535
5536 // WITHIN
5537 // ( a lo hi -- a>=lo&&a<hi )
5538 UFWORD(WITHIN) {
5539   //const int32_t hi = (int32_t)ufoPop();
5540   //const int32_t lo = (int32_t)ufoPop();
5541   //const int32_t a = (int32_t)ufoPop();
5542   //ufoPushBool(a >= lo && a < hi);
5543   // sadly, idiotic ANS standard requires this:
5544   const uint32_t hi = ufoPop();
5545   const uint32_t lo = ufoPop();
5546   const uint32_t a = ufoPop();
5547   ufoPushBool(a - lo < hi - lo);
5548 }
5549
5550 // UWITHIN
5551 // ( ua ulo uhi -- ua>=ulo&&ua<uhi )
5552 UFWORD(UWITHIN) {
5553   const uint32_t hi = ufoPop();
5554   const uint32_t lo = ufoPop();
5555   const uint32_t a = ufoPop();
5556   ufoPushBool(a >= lo && a < hi);
5557 }
5558
5559 // BOUNDS?
5560 // ( ua ulo uhi -- ua>=ulo&&ua<=uhi )
5561 UFWORD(BOUNDSQ) {
5562   const uint32_t hi = ufoPop();
5563   const uint32_t lo = ufoPop();
5564   const uint32_t a = ufoPop();
5565   ufoPushBool(a >= lo && a <= hi);
5566 }
5567
5568 // BSWAP16
5569 // ( u -- u )
5570 UFWORD(BSWAP16) {
5571   UFO_STACK(1);
5572   const uint32_t a = UFO_TOS;
5573   UFO_TOS = (uint32_t)__builtin_bswap16((uint16_t)a);
5574 }
5575
5576 // BSWAP32
5577 // ( u -- u )
5578 UFWORD(BSWAP32) {
5579   UFO_STACK(1);
5580   const uint32_t a = UFO_TOS;
5581   UFO_TOS = __builtin_bswap32(a);
5582 }
5583
5584 // (SWAP:1+:SWAP)
5585 // ( a b -- a+1 b )
5586 UFWORD(PAR_SWAP_INC_SWAP) {
5587   UFO_STACK(2);
5588   UFO_S(1) += 1u;
5589 }
5590
5591 // 1+
5592 // ( a -- a+1 )
5593 UFWORD(1ADD) {
5594   UFO_STACK(1);
5595   UFO_TOS += 1u;
5596 }
5597
5598 // 1-
5599 // ( a -- a-1 )
5600 UFWORD(1SUB) {
5601   UFO_STACK(1);
5602   UFO_TOS -= 1u;
5603 }
5604
5605 // 2+
5606 // ( a -- a+2 )
5607 UFWORD(2ADD) {
5608   UFO_STACK(1);
5609   UFO_TOS += 2u;
5610 }
5611
5612 // 2-
5613 // ( a -- a-2 )
5614 UFWORD(2SUB) {
5615   UFO_STACK(1);
5616   UFO_TOS -= 2u;
5617 }
5618
5619 // 4+
5620 // ( a -- a+4 )
5621 UFWORD(4ADD) {
5622   UFO_STACK(1);
5623   UFO_TOS += 4u;
5624 }
5625
5626 // 4-
5627 // ( a -- a-4 )
5628 UFWORD(4SUB) {
5629   UFO_STACK(1);
5630   UFO_TOS -= 4u;
5631 }
5632
5633 // 8+
5634 // ( a -- a+8 )
5635 UFWORD(8ADD) {
5636   UFO_STACK(1);
5637   UFO_TOS += 8u;
5638 }
5639
5640 // 8-
5641 // ( a -- a-8 )
5642 UFWORD(8SUB) {
5643   UFO_STACK(1);
5644   UFO_TOS -= 8u;
5645 }
5646
5647 // +CELLS
5648 // ( a n -- a+n*4 )
5649 UFWORD(ADD_CELLS) {
5650   const uint32_t n = ufoPop();
5651   UFO_STACK(1);
5652   UFO_TOS += n << 2;
5653 }
5654
5655 // -CELLS
5656 // ( a n -- a-n*4 )
5657 UFWORD(SUB_CELLS) {
5658   const uint32_t n = ufoPop();
5659   UFO_STACK(1);
5660   UFO_TOS -= n << 2;
5661 }
5662
5663 // 2*
5664 // ( a -- a<<1 )
5665 UFWORD(2MUL) {
5666   UFO_STACK(1);
5667   UFO_TOS <<= 1;
5668 }
5669
5670 // 4*
5671 // ( a -- a<<2 )
5672 UFWORD(4MUL) {
5673   UFO_STACK(1);
5674   UFO_TOS <<= 2;
5675 }
5676
5677 // 8*
5678 // ( a -- a<<3 )
5679 UFWORD(8MUL) {
5680   UFO_STACK(1);
5681   UFO_TOS <<= 3;
5682 }
5683
5684 // 2/
5685 // ( a -- a>>1 )
5686 UFWORD(2DIV) {
5687   UFO_STACK(1);
5688   UFO_TOS = (uint32_t)((int32_t)UFO_TOS >> 1);
5689 }
5690
5691 // 4/
5692 // ( a -- a>>2 )
5693 UFWORD(4DIV) {
5694   UFO_STACK(1);
5695   UFO_TOS = (uint32_t)((int32_t)UFO_TOS >> 2);
5696 }
5697
5698 // 8/
5699 // ( a -- a>>3 )
5700 UFWORD(8DIV) {
5701   UFO_STACK(1);
5702   UFO_TOS = (uint32_t)((int32_t)UFO_TOS >> 3);
5703 }
5704
5705 // 2U/
5706 // ( a -- a>>1 )
5707 UFWORD(2UDIV) {
5708   UFO_STACK(1);
5709   UFO_TOS >>= 1;
5710 }
5711
5712 // 4U/
5713 // ( a -- a>>2 )
5714 UFWORD(4UDIV) {
5715   UFO_STACK(1);
5716   UFO_TOS >>= 2;
5717 }
5718
5719 // 8U/
5720 // ( a -- a>>3 )
5721 UFWORD(8UDIV) {
5722   UFO_STACK(1);
5723   UFO_TOS >>= 3;
5724 }
5725
5726 // 0<
5727 // ( a -- a<0? )
5728 UFWORD(0LESS) {
5729   UFO_STACK(1);
5730   if ((int32_t)UFO_TOS < 0) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
5731 }
5732
5733 // 0<=
5734 // ( a -- a<=0? )
5735 UFWORD(0LESSEQU) {
5736   UFO_STACK(1);
5737   if ((int32_t)UFO_TOS <= 0) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
5738 }
5739
5740 // 0>
5741 // ( a -- a>0? )
5742 UFWORD(0GREAT) {
5743   UFO_STACK(1);
5744   if ((int32_t)UFO_TOS > 0) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
5745 }
5746
5747 // 0>=
5748 // ( a -- a>=0? )
5749 UFWORD(0GREATEQU) {
5750   UFO_STACK(1);
5751   if ((int32_t)UFO_TOS >= 0) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
5752 }
5753
5754
5755 // ////////////////////////////////////////////////////////////////////////// //
5756 // string unescaping
5757 //
5758
5759 // (UNESCAPE)
5760 // ( addr count -- addr count )
5761 UFWORD(PAR_UNESCAPE) {
5762   const uint32_t count = ufoPop();
5763   const uint32_t addr = ufoPeek();
5764   if ((count & ((uint32_t)1<<31)) == 0) {
5765     const uint32_t eaddr = addr + count;
5766     uint32_t caddr = addr;
5767     uint32_t daddr = addr;
5768     while (caddr != eaddr) {
5769       uint8_t ch = ufoImgGetU8(caddr); caddr += 1u;
5770       if (ch == '\\' && caddr != eaddr) {
5771         ch = ufoImgGetU8(caddr); caddr += 1u;
5772         switch (ch) {
5773           case 'r': ch = '\r'; break;
5774           case 'n': ch = '\n'; break;
5775           case 't': ch = '\t'; break;
5776           case 'e': ch = '\x1b'; break;
5777           case '`': ch = '"'; break; // special escape to insert double-quote
5778           case '"': ch = '"'; break;
5779           case '\\': ch = '\\'; break;
5780           case 'x': case 'X':
5781             if (eaddr - daddr >= 1) {
5782               const int dg0 = digitInBase((char)(ufoImgGetU8(caddr)), 16);
5783               if (dg0 < 0) ufoFatal("invalid hex string escape");
5784               if (eaddr - daddr >= 2) {
5785                 const int dg1 = digitInBase((char)(ufoImgGetU8(caddr + 1u)), 16);
5786                 if (dg1 < 0) ufoFatal("invalid hex string escape");
5787                 ch = (uint8_t)(dg0 * 16 + dg1);
5788                 caddr += 2u;
5789               } else {
5790                 ch = (uint8_t)dg0;
5791                 caddr += 1u;
5792               }
5793             } else {
5794               ufoFatal("invalid hex string escape");
5795             }
5796             break;
5797           default: ufoFatal("invalid string escape");
5798         }
5799       }
5800       ufoImgPutU8(daddr, ch); daddr += 1u;
5801     }
5802     ufoPush(daddr - addr);
5803   } else {
5804     ufoPush(count);
5805   }
5806 }
5807
5808
5809 // ////////////////////////////////////////////////////////////////////////// //
5810 // numeric conversions
5811 //
5812
5813 // (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
5814 UFWORD(PAR_BASED_NUMBER) {
5815   const uint32_t xbase = ufoPop();
5816   const uint32_t allowSign = ufoPop();
5817   int32_t count = (int32_t)ufoPop();
5818   uint32_t addr = ufoPop();
5819   uint32_t n = 0;
5820   int base = 0;
5821   int neg = 0;
5822   uint8_t ch;
5823
5824   if (allowSign && count > 1) {
5825     ch = ufoImgGetU8(addr);
5826     if (ch == '-') { neg = 1; addr += 1u; count -= 1; }
5827     else if (ch == '+') { neg = 0; addr += 1u; count -= 1; }
5828   }
5829
5830   // special-based numbers
5831   ch = ufoImgGetU8(addr);
5832   if (count >= 3 && ch == '0') {
5833     switch (ufoImgGetU8(addr + 1u)) {
5834       case 'x': case 'X': base = 16; break;
5835       case 'o': case 'O': base = 8; break;
5836       case 'b': case 'B': base = 2; break;
5837       case 'd': case 'D': base = 10; break;
5838       default: break;
5839     }
5840     if (base && digitInBase((char)ufoImgGetU8(addr + (uint32_t)count - 1u), base) >= 0) {
5841       addr += 2; count -= 2;
5842     } else {
5843       base = 0;
5844     }
5845   } else if (count >= 2 && ch == '$') {
5846     base = 16;
5847     addr += 1u; count -= 1;
5848   } else if (count >= 2 && ch == '#') {
5849     base = 16;
5850     addr += 1u; count -= 1;
5851   } else if (count >= 2 && ch == '%') {
5852     base = 2;
5853     addr += 1u; count -= 1;
5854   } else if (count >= 3 && ch == '&') {
5855     switch (ufoImgGetU8(addr + 1u)) {
5856       case 'h': case 'H': base = 16; break;
5857       case 'o': case 'O': base = 8; break;
5858       case 'b': case 'B': base = 2; break;
5859       case 'd': case 'D': base = 10; break;
5860       default: break;
5861     }
5862     if (base) { addr += 2u; count -= 2; }
5863   }
5864   if (!base && count > 2 && ch >= '0' && ch <= '9') {
5865     ch = ufoImgGetU8(addr + (uint32_t)count - 1u);
5866     switch (ch) {
5867       case 'b': case 'B': if (xbase < 12) base = 2; break;
5868       case 'o': case 'O': if (xbase < 25) base = 8; break;
5869       case 'h': case 'H': if (xbase < 18) base = 16; break;
5870     }
5871     if (base) count -= 1;
5872   }
5873
5874   // in current base?
5875   if (!base && xbase < 255) base = xbase;
5876
5877   if (count <= 0 || base < 1 || base > 36) {
5878     ufoPushBool(0);
5879   } else {
5880     uint32_t nc;
5881     int wasDig = 0, wasUnder = 1, error = 0, dig;
5882     while (!error && count != 0) {
5883       ch = ufoImgGetU8(addr); addr += 1u; count -= 1;
5884       if (ch != '_') {
5885         error = 1; wasUnder = 0; wasDig = 1;
5886         dig = digitInBase((char)ch, (int)base);
5887         if (dig >= 0) {
5888           nc = n * (uint32_t)base;
5889           if (nc >= n) {
5890             nc += (uint32_t)dig;
5891             if (nc >= n) {
5892               n = nc;
5893               error = 0;
5894             }
5895           }
5896         }
5897       } else {
5898         error = wasUnder;
5899         wasUnder = 1;
5900       }
5901     }
5902
5903     if (!error && wasDig && !wasUnder) {
5904       if (allowSign && neg) n = ~n + 1u;
5905       ufoPush(n);
5906       ufoPushBool(1);
5907     } else {
5908       ufoPushBool(0);
5909     }
5910   }
5911 }
5912
5913
5914 // ////////////////////////////////////////////////////////////////////////// //
5915 // compiler-related, dictionary-related
5916 //
5917
5918 static char ufoWNameBuf[256];
5919
5920 // (CREATE-WORD-HEADER)
5921 // ( addr count word-flags -- )
5922 UFWORD(PAR_CREATE_WORD_HEADER) {
5923   const uint32_t flags = ufoPop();
5924   const uint32_t wlen = ufoPop();
5925   const uint32_t waddr = ufoPop();
5926   if (wlen == 0) ufoFatal("word name expected");
5927   if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
5928   // copy to separate buffer
5929   for (uint32_t f = 0; f < wlen; f += 1) {
5930     ufoWNameBuf[f] = (char)ufoImgGetU8(waddr + f);
5931   }
5932   ufoWNameBuf[wlen] = 0;
5933   ufoCreateWordHeader(ufoWNameBuf, flags);
5934 }
5935
5936 // (CREATE-NAMELESS-WORD-HEADER)
5937 // ( word-flags -- )
5938 UFWORD(PAR_CREATE_NAMELESS_WORD_HEADER) {
5939   const uint32_t flags = ufoPop();
5940   ufoCreateWordHeader("", flags);
5941 }
5942
5943 // FIND-WORD
5944 // ( addr count -- cfa TRUE / FALSE )
5945 UFWORD(FIND_WORD) {
5946   const uint32_t wlen = ufoPop();
5947   const uint32_t waddr = ufoPop();
5948   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
5949     // copy to separate buffer
5950     for (uint32_t f = 0; f < wlen; f += 1) {
5951       ufoWNameBuf[f] = (char)ufoImgGetU8(waddr + f);
5952     }
5953     ufoWNameBuf[wlen] = 0;
5954     const uint32_t cfa = ufoFindWord(ufoWNameBuf);
5955     if (cfa != 0) {
5956       ufoPush(cfa);
5957       ufoPushBool(1);
5958     } else {
5959       ufoPushBool(0);
5960     }
5961   } else {
5962     ufoPushBool(0);
5963   }
5964 }
5965
5966 // (FIND-WORD-IN-VOC)
5967 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
5968 // find only in the given voc; no name resolution
5969 UFWORD(PAR_FIND_WORD_IN_VOC) {
5970   const uint32_t allowHidden = ufoPop();
5971   const uint32_t vocid = ufoPop();
5972   const uint32_t wlen = ufoPop();
5973   const uint32_t waddr = ufoPop();
5974   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
5975     // copy to separate buffer
5976     for (uint32_t f = 0; f < wlen; f += 1) {
5977       ufoWNameBuf[f] = (char)ufoImgGetU8(waddr + f);
5978     }
5979     ufoWNameBuf[wlen] = 0;
5980     const uint32_t cfa = ufoFindWordInVoc(ufoWNameBuf, wlen, 0, vocid, (allowHidden ? 1 : 0));
5981     if (cfa != 0) {
5982       ufoPush(cfa);
5983       ufoPushBool(1);
5984     } else {
5985       ufoPushBool(0);
5986     }
5987   } else {
5988     ufoPushBool(0);
5989   }
5990 }
5991
5992 // (FIND-WORD-IN-VOC-AND-PARENTS)
5993 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
5994 // find only in the given voc; no name resolution
5995 UFWORD(PAR_FIND_WORD_IN_VOC_AND_PARENTS) {
5996   const uint32_t allowHidden = ufoPop();
5997   const uint32_t vocid = ufoPop();
5998   const uint32_t wlen = ufoPop();
5999   const uint32_t waddr = ufoPop();
6000   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
6001     // copy to separate buffer
6002     for (uint32_t f = 0; f < wlen; f += 1) {
6003       ufoWNameBuf[f] = (char)ufoImgGetU8(waddr + f);
6004     }
6005     ufoWNameBuf[wlen] = 0;
6006     const uint32_t cfa = ufoFindWordInVocAndParents(ufoWNameBuf, wlen, 0, vocid, (allowHidden ? 1 : 0));
6007     if (cfa != 0) {
6008       ufoPush(cfa);
6009       ufoPushBool(1);
6010     } else {
6011       ufoPushBool(0);
6012     }
6013   } else {
6014     ufoPushBool(0);
6015   }
6016 }
6017
6018 // FIND-WORD-IN-VOC
6019 // ( addr count vocid -- cfa TRUE / FALSE)
6020 // find only in the given voc; no name resolution, no hidden words
6021 UFWORD(FIND_WORD_IN_VOC) { ufoPush(0); UFCALL(PAR_FIND_WORD_IN_VOC); }
6022
6023 // FIND-WORD-IN-VOC-AND-PARENTS
6024 // ( addr count vocid -- cfa TRUE / FALSE)
6025 // find only in the given voc; no name resolution, no hidden words
6026 UFWORD(FIND_WORD_IN_VOC_AND_PARENTS) { ufoPush(0); UFCALL(PAR_FIND_WORD_IN_VOC_AND_PARENTS); }
6027
6028
6029 // ////////////////////////////////////////////////////////////////////////// //
6030 // more compiler words
6031 //
6032
6033 // ////////////////////////////////////////////////////////////////////////// //
6034 // vocabulary and wordlist utilities
6035 //
6036
6037 // (VSP@)
6038 // ( -- vsp )
6039 UFWORD(PAR_GET_VSP) {
6040   ufoPush(ufoVSP);
6041 }
6042
6043 // (VSP!)
6044 // ( vsp -- )
6045 UFWORD(PAR_SET_VSP) {
6046   const uint32_t vsp = ufoPop();
6047   if (vsp > UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
6048   ufoVSP = vsp;
6049 }
6050
6051 // (VSP-AT@)
6052 // ( idx -- value )
6053 UFWORD(PAR_VSP_LOAD) {
6054   const uint32_t vsp = ufoPop();
6055   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
6056   ufoPush(ufoVocStack[vsp]);
6057 }
6058
6059 // (VSP-AT!)
6060 // ( value idx -- )
6061 UFWORD(PAR_VSP_STORE) {
6062   const uint32_t vsp = ufoPop();
6063   const uint32_t value = ufoPop();
6064   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
6065   ufoVocStack[vsp] = value;
6066 }
6067
6068
6069 // ////////////////////////////////////////////////////////////////////////// //
6070 // word field address conversion
6071 //
6072
6073 // CFA->DOES-CFA
6074 // ( cfa -- does-cfa )
6075 UFWORD(CFA2DOESCFA) {
6076   UFO_STACK(1);
6077   UFO_TOS = UFO_CFA_TO_DOES_CFA(UFO_TOS);
6078 }
6079
6080 // CFA->PFA
6081 // ( cfa -- pfa )
6082 UFWORD(CFA2PFA) {
6083   UFO_STACK(1);
6084   UFO_TOS = UFO_CFA_TO_PFA(UFO_TOS);
6085 }
6086
6087 // CFA->NFA
6088 // ( cfa -- nfa )
6089 UFWORD(CFA2NFA) {
6090   UFO_STACK(1);
6091   UFO_TOS = UFO_CFA_TO_NFA(UFO_TOS);
6092 }
6093
6094 // CFA->LFA
6095 // ( cfa -- lfa )
6096 UFWORD(CFA2LFA) {
6097   UFO_STACK(1);
6098   UFO_TOS = UFO_CFA_TO_LFA(UFO_TOS);
6099 }
6100
6101 // CFA->WEND
6102 // ( cfa -- wend-addr )
6103 UFWORD(CFA2WEND) {
6104   UFO_STACK(1);
6105   UFO_TOS = ufoGetWordEndAddr(UFO_TOS);
6106 }
6107
6108 // PFA->CFA
6109 // ( pfa -- cfa )
6110 UFWORD(PFA2CFA) {
6111   UFO_STACK(1);
6112   UFO_TOS = UFO_PFA_TO_CFA(UFO_TOS);
6113 }
6114
6115 // PFA->NFA
6116 // ( pfa -- nfa )
6117 UFWORD(PFA2NFA) {
6118   UFO_STACK(1);
6119   UFO_TOS = UFO_PFA_TO_CFA(UFO_TOS);
6120   UFO_TOS = UFO_CFA_TO_NFA(UFO_TOS);
6121 }
6122
6123 // NFA->CFA
6124 // ( nfa -- cfa )
6125 UFWORD(NFA2CFA) {
6126   UFO_STACK(1);
6127   UFO_TOS = UFO_NFA_TO_CFA(UFO_TOS);
6128 }
6129
6130 // NFA->PFA
6131 // ( nfa -- pfa )
6132 UFWORD(NFA2PFA) {
6133   UFO_STACK(1);
6134   UFO_TOS = UFO_NFA_TO_CFA(UFO_TOS);
6135   UFO_TOS = UFO_CFA_TO_PFA(UFO_TOS);
6136 }
6137
6138 // NFA->LFA
6139 // ( nfa -- lfa )
6140 UFWORD(NFA2LFA) {
6141   UFO_STACK(1);
6142   UFO_TOS = UFO_NFA_TO_LFA(UFO_TOS);
6143 }
6144
6145 // LFA->CFA
6146 // ( lfa -- cfa )
6147 UFWORD(LFA2CFA) {
6148   UFO_STACK(1);
6149   UFO_TOS = UFO_LFA_TO_CFA(UFO_TOS);
6150 }
6151
6152 // LFA->PFA
6153 // ( lfa -- pfa )
6154 UFWORD(LFA2PFA) {
6155   UFO_STACK(1);
6156   UFO_TOS = UFO_LFA_TO_CFA(UFO_TOS);
6157   UFO_TOS = UFO_CFA_TO_PFA(UFO_TOS);
6158 }
6159
6160 // LFA->BFA
6161 // ( lfa -- bfa )
6162 UFWORD(LFA2BFA) {
6163   UFO_STACK(1);
6164   UFO_TOS = UFO_LFA_TO_BFA(UFO_TOS);
6165 }
6166
6167 // LFA->XFA
6168 // ( lfa -- xfa )
6169 UFWORD(LFA2XFA) {
6170   UFO_STACK(1);
6171   UFO_TOS = UFO_LFA_TO_XFA(UFO_TOS);
6172 }
6173
6174 // LFA->YFA
6175 // ( lfa -- yfa )
6176 UFWORD(LFA2YFA) {
6177   UFO_STACK(1);
6178   UFO_TOS = UFO_LFA_TO_YFA(UFO_TOS);
6179 }
6180
6181 // LFA->NFA
6182 // ( lfa -- nfa )
6183 UFWORD(LFA2NFA) {
6184   UFO_STACK(1);
6185   UFO_TOS = UFO_LFA_TO_NFA(UFO_TOS);
6186 }
6187
6188 // IP->NFA
6189 // ( ip -- nfa / 0 )
6190 UFWORD(IP2NFA) {
6191   UFO_STACK(1);
6192   UFO_TOS = ufoFindWordForIP(UFO_TOS);
6193 }
6194
6195 // IP->FILE/LINE
6196 // ( ip -- addr count line TRUE / FALSE )
6197 // name is at PAD; it is safe to use PAD, because each task has its own temp image
6198 UFWORD(IP2FILELINE) {
6199   const uint32_t ip = ufoPop();
6200   uint32_t fline;
6201   const char *fname = ufoFindFileForIP(ip, &fline, NULL, NULL);
6202   if (fname != NULL) {
6203     uint32_t addr = UFO_PAD_ADDR;
6204     uint32_t count = 0;
6205     while (*fname != 0) {
6206       ufoImgPutU8(addr, *(const unsigned char *)fname);
6207       fname += 1u; addr += 1u; count += 1u;
6208     }
6209     ufoImgPutU8(addr, 0); // just in case
6210     ufoPush(count);
6211     ufoPush(fline);
6212     ufoPushBool(1);
6213   } else {
6214     ufoPushBool(0);
6215   }
6216 }
6217
6218
6219 // IP->FILE-HASH/LINE
6220 // ( ip -- len hash line TRUE / FALSE )
6221 UFWORD(IP2FILEHASHLINE) {
6222   const uint32_t ip = ufoPop();
6223   uint32_t fline, fhash, flen;
6224   const char *fname = ufoFindFileForIP(ip, &fline, &flen, &fhash);
6225   if (fname != NULL) {
6226     ufoPush(flen);
6227     ufoPush(fhash);
6228     ufoPush(fline);
6229     ufoPushBool(1);
6230   } else {
6231     ufoPushBool(0);
6232   }
6233 }
6234
6235
6236 // ////////////////////////////////////////////////////////////////////////// //
6237 // string operations
6238 //
6239
6240 UFO_FORCE_INLINE uint32_t ufoHashBuf (uint32_t addr, uint32_t size, uint8_t orbyte) {
6241   uint32_t hash = 0x29a;
6242   if ((size & ((uint32_t)1<<31)) == 0) {
6243     while (size != 0) {
6244       hash += ufoImgGetU8(addr) | orbyte;
6245       hash += hash<<10;
6246       hash ^= hash>>6;
6247       addr += 1u; size -= 1u;
6248     }
6249   }
6250   // finalize
6251   hash += hash<<3;
6252   hash ^= hash>>11;
6253   hash += hash<<15;
6254   return hash;
6255 }
6256
6257 //==========================================================================
6258 //
6259 //  ufoBufEqu
6260 //
6261 //==========================================================================
6262 UFO_FORCE_INLINE int ufoBufEqu (uint32_t addr0, uint32_t addr1, uint32_t count) {
6263   int res;
6264   if ((count & ((uint32_t)1<<31)) == 0) {
6265     res = 1;
6266     while (res != 0 && count != 0) {
6267       res = (toUpperU8(ufoImgGetU8(addr0)) == toUpperU8(ufoImgGetU8(addr1)));
6268       addr0 += 1u; addr1 += 1u; count -= 1u;
6269     }
6270   } else {
6271     res = 0;
6272   }
6273   return res;
6274 }
6275
6276 // STRING:=
6277 // ( a0 c0 a1 c1 -- bool )
6278 UFWORD(STREQU) {
6279   int32_t c1 = (int32_t)ufoPop();
6280   uint32_t a1 = ufoPop();
6281   int32_t c0 = (int32_t)ufoPop();
6282   uint32_t a0 = ufoPop();
6283   if (c0 < 0) c0 = 0;
6284   if (c1 < 0) c1 = 0;
6285   if (c0 == c1) {
6286     int res = 1;
6287     while (res != 0 && c0 != 0) {
6288       res = (ufoImgGetU8(a0) == ufoImgGetU8(a1));
6289       a0 += 1; a1 += 1; c0 -= 1;
6290     }
6291     ufoPushBool(res);
6292   } else {
6293     ufoPushBool(0);
6294   }
6295 }
6296
6297 // STRING:=CI
6298 // ( a0 c0 a1 c1 -- bool )
6299 UFWORD(STREQUCI) {
6300   int32_t c1 = (int32_t)ufoPop();
6301   uint32_t a1 = ufoPop();
6302   int32_t c0 = (int32_t)ufoPop();
6303   uint32_t a0 = ufoPop();
6304   if (c0 < 0) c0 = 0;
6305   if (c1 < 0) c1 = 0;
6306   if (c0 == c1) {
6307     int res = 1;
6308     while (res != 0 && c0 != 0) {
6309       res = (toUpperU8(ufoImgGetU8(a0)) == toUpperU8(ufoImgGetU8(a1)));
6310       a0 += 1; a1 += 1; c0 -= 1;
6311     }
6312     ufoPushBool(res);
6313   } else {
6314     ufoPushBool(0);
6315   }
6316 }
6317
6318 // search the string specified by c-addr1 u1 for the string specified by c-addr2 u2.
6319 // if flag is true, a match was found at c-addr3 with u3 characters remaining.
6320 // if flag is false there was no match and c-addr3 is c-addr1 and u3 is u1.
6321 // ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag )
6322 UFWORD(SEARCH) {
6323   const uint32_t pcount = ufoPop();
6324   const uint32_t paddr = ufoPop();
6325   const uint32_t tcount = ufoPop();
6326   const uint32_t taddr = ufoPop();
6327   if ((pcount & ((uint32_t)1 << 31)) == 0 && (tcount & ((uint32_t)1 << 31)) == 0) {
6328     for (uint32_t f = 0; tcount - f >= pcount; f += 1) {
6329       if (ufoBufEqu(taddr + f, paddr, pcount)) {
6330         ufoPush(taddr + f);
6331         ufoPush(tcount - f);
6332         ufoPushBool(1);
6333         return;
6334       }
6335     }
6336   }
6337   ufoPush(taddr);
6338   ufoPush(tcount);
6339   ufoPushBool(0);
6340 }
6341
6342 // STRING:HASH
6343 // ( addr count -- hash )
6344 UFWORD(STRHASH) {
6345   uint32_t count = ufoPop();
6346   uint32_t addr = ufoPop();
6347   ufoPush(ufoHashBuf(addr, count, 0));
6348 }
6349
6350 // STRING:HASH-CI
6351 // ( addr count -- hash )
6352 UFWORD(STRHASHCI) {
6353   uint32_t count = ufoPop();
6354   uint32_t addr = ufoPop();
6355   ufoPush(ufoHashBuf(addr, count, 0x20));
6356 }
6357
6358 // STRING:CHAR-UPPER
6359 // ( ch -- ch )
6360 UFWORD(CHAR_UPPER) {
6361   UFO_STACK(1);
6362   uint32_t c = UFO_TOS & 0xffU;
6363   if (c >= 'a' && c <= 'z') c = c - 'a' + 'A';
6364   UFO_TOS = c;
6365 }
6366
6367 // STRING:CHAR-LOWER
6368 // ( ch -- ch )
6369 UFWORD(CHAR_LOWER) {
6370   UFO_STACK(1);
6371   uint32_t c = UFO_TOS & 0xffU;
6372   if (c >= 'A' && c <= 'Z') c = c - 'A' + 'a';
6373   UFO_TOS = c;
6374 }
6375
6376 // STRING:UPPER
6377 // ( addr count -- )
6378 UFWORD(STRUPPER) {
6379   int32_t count = (int32_t)ufoPop();
6380   uint32_t addr = ufoPop();
6381   while (count > 0) {
6382     uint32_t c = ufoImgGetU8(addr);
6383     if (c >= 'a' && c <= 'z') {
6384       c = c - 'a' + 'A';
6385       ufoImgPutU8(addr, c);
6386     }
6387     addr += 1u; count -= 1;
6388   }
6389 }
6390
6391 // STRING:LOWER
6392 // ( addr count -- )
6393 UFWORD(STRLOWER) {
6394   int32_t count = (int32_t)ufoPop();
6395   uint32_t addr = ufoPop();
6396   while (count > 0) {
6397     uint32_t c = ufoImgGetU8(addr);
6398     if (c >= 'A' && c <= 'Z') {
6399       c = c - 'A' + 'a';
6400       ufoImgPutU8(addr, c);
6401     }
6402     addr += 1u; count -= 1;
6403   }
6404 }
6405
6406 // STRING:(CHAR-DIGIT)
6407 // ( ch -- digit true // false )
6408 UFWORD(CHAR_DIGIT) {
6409   UFO_STACK(1);
6410   const uint32_t c = UFO_TOS;
6411   if (c >= '0' && c <= '9') { UFO_TOS = c - '0'; ufoPushBool(1); }
6412   else if (c >= 'A' && c <= 'Z') { UFO_TOS = c - 'A' + 10; ufoPushBool(1); }
6413   else if (c >= 'a' && c <= 'z') { UFO_TOS = c - 'a' + 10; ufoPushBool(1); }
6414   else UFO_TOS = 0;
6415 }
6416
6417 // STRING:DIGIT
6418 // ( char base -- digit TRUE / FALSE )
6419 UFWORD(DIGIT) {
6420   const uint32_t base = ufoPop();
6421   UFO_STACK(1);
6422   if (base > 0 && base < 0x80000000u) {
6423     uint32_t c = UFO_TOS;
6424     if (c >= '0' && c <= '9') c = c - '0';
6425     else if (c >= 'A' && c <= 'Z') c = c - 'A' + 10;
6426     else if (c >= 'a' && c <= 'z') c = c - 'a' + 10;
6427     else { UFO_TOS = 0; return; }
6428     if (c < base) { UFO_TOS = c; ufoPushBool(1); } else UFO_TOS = 0;
6429   } else {
6430     UFO_TOS = 0;
6431   }
6432 }
6433
6434 // STRING:DIGIT?
6435 // ( char base -- TRUE / FALSE )
6436 UFWORD(DIGITQ) {
6437   const uint32_t base = ufoPop();
6438   UFO_STACK(1);
6439   if (base > 0 && base < 0x80000000u) {
6440     uint32_t c = UFO_TOS;
6441     if (c >= '0' && c <= '9') c = c - '0';
6442     else if (c >= 'A' && c <= 'Z') c = c - 'A' + 10;
6443     else if (c >= 'a' && c <= 'z') c = c - 'a' + 10;
6444     else { UFO_TOS = 0; return; }
6445     if (c < base) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6446   } else {
6447     UFO_TOS = 0;
6448   }
6449 }
6450
6451
6452 // MEMCMP
6453 // ( addr1 addr2 size -- -1|0|1 )
6454 UFWORD(MEMCMP) {
6455   uint32_t count = ufoPop();
6456   uint32_t addr1 = ufoPop();
6457   uint32_t addr0 = ufoPop();
6458   if ((count & 0x80000000u) == 0) {
6459     while (count != 0) {
6460       const int n = (int)ufoImgGetU8(addr0) - (int)ufoImgGetU8(addr1);
6461       if (n != 0) {
6462         if (n < 0) ufoPush(~(uint32_t)0); else ufoPush(1);
6463         return;
6464       }
6465       addr0 += 1u; addr1 += 1u; count -= 1u;
6466     }
6467     ufoPush(0);
6468   } else {
6469     ufoFatal("invalid MEMCMP counter");
6470   }
6471 }
6472
6473 // MEMCMP-CI
6474 // ( addr1 addr2 size -- -1|0|1 )
6475 UFWORD(MEMCMP_CI) {
6476   uint32_t count = ufoPop();
6477   uint32_t addr1 = ufoPop();
6478   uint32_t addr0 = ufoPop();
6479   if ((count & 0x80000000u) == 0) {
6480     while (count != 0) {
6481       const int c0 = (int)toUpperU8(ufoImgGetU8(addr0));
6482       const int c1 = (int)toUpperU8(ufoImgGetU8(addr1));
6483       const int n = c0 - c1;
6484       if (n != 0) {
6485         if (n < 0) ufoPush(~(uint32_t)0); else ufoPush(1);
6486         return;
6487       }
6488       addr0 += 1u; addr1 += 1u; count -= 1u;
6489     }
6490     ufoPush(0);
6491   } else {
6492     ufoFatal("invalid MEMCMP counter");
6493   }
6494 }
6495
6496 // FILL-CELLS
6497 // ( addr count u32 -- )
6498 UFWORD(FILL_CELLS) {
6499   const uint32_t v = ufoPop();
6500   uint32_t count = ufoPop();
6501   uint32_t dest = ufoPop();
6502   if ((count & 0x80000000u) == 0) {
6503     while (count != 0) {
6504       ufoImgPutU32(dest, v);
6505       dest += 4u; count -= 1u;
6506     }
6507   }
6508 }
6509
6510 // FILL
6511 // ( addr count byte -- )
6512 UFWORD(FILL) {
6513   const uint32_t v = ufoPop() & 0xffU;
6514   uint32_t count = ufoPop();
6515   uint32_t dest = ufoPop();
6516   if (count != 0 && (count & 0x80000000u) == 0) {
6517     while (count != 0 && (dest & 3) != 0) {
6518       ufoImgPutU8(dest, v);
6519       dest += 1u; count -= 1u;
6520     }
6521     if (count >= 4u) {
6522       const uint32_t vv = (v << 24) | (v << 16) | (v << 8) | v;
6523       while (count >= 4u) {
6524         ufoImgPutU32(dest, vv);
6525         dest += 4u; count -= 4u;
6526       }
6527     }
6528     while (count != 0) {
6529       ufoImgPutU8(dest, v);
6530       dest += 1u; count -= 1u;
6531     }
6532   }
6533 }
6534
6535 //==========================================================================
6536 //
6537 //  doCMoveFwd
6538 //
6539 //==========================================================================
6540 static void doCMoveFwd (uint32_t src, uint32_t dest, uint32_t count) {
6541   uint32_t v;
6542   if (count != 0 && (count & 0x80000000u) == 0 && src != dest) {
6543     if ((src & 3) == (dest & 3)) {
6544       // we can align addresses
6545       while (count != 0 && (src & 3) != 0) {
6546         v = ufoImgGetU8(src); ufoImgPutU8(dest, v);
6547         src += 1u; dest += 1u; count -= 1u;
6548       }
6549       // ...and move by whole cells
6550       while (count >= 4u) {
6551         v = ufoImgGetU32(src); ufoImgPutU32(dest, v);
6552         src += 4u; dest += 4u; count -= 4u;
6553       }
6554     }
6555     // do the rest
6556     while (count != 0) {
6557       v = ufoImgGetU8(src); ufoImgPutU8(dest, v);
6558       src += 1u; dest += 1u; count -= 1u;
6559     }
6560   }
6561 }
6562
6563 //==========================================================================
6564 //
6565 //  doCMoveBwd
6566 //
6567 //==========================================================================
6568 static void doCMoveBwd (uint32_t src, uint32_t dest, uint32_t count) {
6569   if (count != 0 && (count & 0x80000000u) == 0 && src != dest) {
6570     src += count; dest += count;
6571     while (count != 0) {
6572       src -= 1u; dest -= 1u; count -= 1u;
6573       const uint8_t v = ufoImgGetU8(src); ufoImgPutU8(dest, v);
6574     }
6575   }
6576 }
6577
6578 // CMOVE-CELLS
6579 // ( source dest count -- )
6580 UFWORD(CMOVE_CELLS_FWD) {
6581   uint32_t count = ufoPop();
6582   uint32_t dest = ufoPop();
6583   uint32_t src = ufoPop();
6584   if (count != 0 && (count & 0x80000000u) == 0 && src != dest) {
6585     if (count * 4u >= 0x80000000u) ufoFatal("invalid CMOVE-CELLS counter");
6586     doCMoveFwd(src, dest, count * 4u);
6587   }
6588 }
6589
6590 // CMOVE>-CELLS
6591 // ( source dest count -- )
6592 UFWORD(CMOVE_CELLS_BWD) {
6593   uint32_t count = ufoPop();
6594   uint32_t dest = ufoPop();
6595   uint32_t src = ufoPop();
6596   if ((count & 0x80000000u) == 0) {
6597     src += count * 4u; dest += count * 4u;
6598     while (count != 0) {
6599       src -= 4u; dest -= 4u; count -= 1u;
6600       const uint32_t v = ufoImgGetU32(src); ufoImgPutU32(dest, v);
6601     }
6602   }
6603 }
6604
6605 // CMOVE
6606 // ( source dest count -- )
6607 UFWORD(CMOVE_FWD) {
6608   uint32_t count = ufoPop();
6609   uint32_t dest = ufoPop();
6610   uint32_t src = ufoPop();
6611   doCMoveFwd(src, dest, count);
6612 }
6613
6614 // CMOVE>
6615 // ( source dest count -- )
6616 UFWORD(CMOVE_BWD) {
6617   uint32_t count = ufoPop();
6618   uint32_t dest = ufoPop();
6619   uint32_t src = ufoPop();
6620   doCMoveBwd(src, dest, count);
6621 }
6622
6623 // MOVE
6624 // ( source dest count -- )
6625 UFWORD(MOVE) {
6626   uint32_t count = ufoPop();
6627   uint32_t dest = ufoPop();
6628   uint32_t src = ufoPop();
6629   if (count != 0 && (count & 0x80000000u) == 0 && src != dest) {
6630     if (src + count <= src || dest + count <= dest) ufoFatal("invalid MOVE");
6631     if (src <= dest && src + count > dest) doCMoveBwd(src, dest, count);
6632     else doCMoveFwd(src, dest, count);
6633   }
6634 }
6635
6636
6637 // ////////////////////////////////////////////////////////////////////////// //
6638 // heavily used in UrAsm
6639 //
6640
6641 // IS-DIGIT
6642 // ( ch -- bool )
6643 UFWORD(IS_DIGIT) {
6644   UFO_STACK(1);
6645   const uint32_t c = UFO_TOS & 0xffU;
6646   if (c >= '0' && c <= '9') UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6647 }
6648
6649 // IS-BIN-DIGIT
6650 // ( ch -- bool )
6651 UFWORD(IS_BIN_DIGIT) {
6652   UFO_STACK(1);
6653   const uint32_t c = UFO_TOS & 0xffU;
6654   if (c >= '0' && c <= '1') UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6655 }
6656
6657 // IS-OCT-DIGIT
6658 // ( ch -- bool )
6659 UFWORD(IS_OCT_DIGIT) {
6660   UFO_STACK(1);
6661   const uint32_t c = UFO_TOS & 0xffU;
6662   if (c >= '0' && c <= '7') UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6663 }
6664
6665 // IS-HEX-DIGIT
6666 // ( ch -- bool )
6667 UFWORD(IS_HEX_DIGIT) {
6668   UFO_STACK(1);
6669   const uint32_t c = UFO_TOS & 0xffU;
6670   if ((c >= '0' && c <= '9') ||
6671       (c >= 'A' && c <= 'F') ||
6672       (c >= 'a' && c <= 'f')) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6673 }
6674
6675 // IS-ALPHA
6676 // ( ch -- bool )
6677 UFWORD(IS_ALPHA) {
6678   UFO_STACK(1);
6679   const uint32_t c = UFO_TOS & 0xffU;
6680   if ((c >= 'A' && c <= 'Z') ||
6681       (c >= 'a' && c <= 'z')) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6682 }
6683
6684 // IS-UNDER-DOT
6685 // ( ch -- bool )
6686 UFWORD(IS_UNDER_DOT) {
6687   UFO_STACK(1);
6688   const uint32_t c = UFO_TOS & 0xffU;
6689   if (c == '_' || c == '.') UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6690 }
6691
6692 // IS-ALNUM
6693 // ( ch -- bool )
6694 UFWORD(IS_ALNUM) {
6695   UFO_STACK(1);
6696   const uint32_t c = UFO_TOS & 0xffU;
6697   if ((c >= 'A' && c <= 'Z') ||
6698       (c >= 'a' && c <= 'z') ||
6699       (c >= '0' && c <= '9')) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6700 }
6701
6702 // IS-ID-START
6703 // ( ch -- bool )
6704 UFWORD(IS_ID_START) {
6705   UFO_STACK(1);
6706   const uint32_t c = UFO_TOS & 0xffU;
6707   if ((c >= 'A' && c <= 'Z') ||
6708       (c >= 'a' && c <= 'z') ||
6709       c == '_' || c == '.') UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6710 }
6711
6712 // IS-ID-CHAR
6713 // ( ch -- bool )
6714 UFWORD(IS_ID_CHAR) {
6715   UFO_STACK(1);
6716   const uint32_t c = UFO_TOS & 0xffU;
6717   if ((c >= 'A' && c <= 'Z') ||
6718       (c >= 'a' && c <= 'z') ||
6719       (c >= '0' && c <= '9') ||
6720       c == '_' || c == '.') UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6721 }
6722
6723
6724 // ////////////////////////////////////////////////////////////////////////// //
6725 // conditional defines
6726 //
6727
6728 typedef struct UForthCondDefine_t UForthCondDefine;
6729 struct UForthCondDefine_t {
6730   char *name;
6731   uint32_t namelen;
6732   uint32_t hash;
6733   UForthCondDefine *next;
6734 };
6735
6736 static UForthCondDefine *ufoCondDefines = NULL;
6737 static char ufoErrMsgBuf[4096];
6738
6739
6740 //==========================================================================
6741 //
6742 //  ufoStrEquCI
6743 //
6744 //==========================================================================
6745 UFO_DISABLE_INLINE int ufoStrEquCI (const void *str0, const void *str1) {
6746   const unsigned char *s0 = (const unsigned char *)str0;
6747   const unsigned char *s1 = (const unsigned char *)str1;
6748   while (*s0 && *s1) {
6749     if (toUpperU8(*s0) != toUpperU8(*s1)) return 0;
6750     s0 += 1; s1 += 1;
6751   }
6752   return (*s0 == 0 && *s1 == 0);
6753 }
6754
6755
6756 //==========================================================================
6757 //
6758 //  ufoBufEquCI
6759 //
6760 //==========================================================================
6761 UFO_FORCE_INLINE int ufoBufEquCI (uint32_t addr, uint32_t count, const void *buf) {
6762   int res;
6763   if ((count & ((uint32_t)1<<31)) == 0) {
6764     const unsigned char *src = (const unsigned char *)buf;
6765     res = 1;
6766     while (res != 0 && count != 0) {
6767       res = (toUpperU8(*src) == toUpperU8(ufoImgGetU8(addr)));
6768       src += 1; addr += 1u; count -= 1u;
6769     }
6770   } else {
6771     res = 0;
6772   }
6773   return res;
6774 }
6775
6776
6777 //==========================================================================
6778 //
6779 //  ufoClearCondDefines
6780 //
6781 //==========================================================================
6782 static void ufoClearCondDefines (void) {
6783   while (ufoCondDefines) {
6784     UForthCondDefine *df = ufoCondDefines;
6785     ufoCondDefines = df->next;
6786     if (df->name) free(df->name);
6787     free(df);
6788   }
6789 }
6790
6791
6792 //==========================================================================
6793 //
6794 //  ufoHasCondDefine
6795 //
6796 //==========================================================================
6797 int ufoHasCondDefine (const char *name) {
6798   int res = 0;
6799   if (name != NULL && name[0] != 0) {
6800     const size_t nlen = strlen(name);
6801     if (nlen <= 255) {
6802       const uint32_t hash = joaatHashBufCI(name, nlen);
6803       UForthCondDefine *dd = ufoCondDefines;
6804       while (res == 0 && dd != NULL) {
6805         if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
6806           res = ufoStrEquCI(name, dd->name);
6807         }
6808         dd = dd->next;
6809       }
6810     }
6811   }
6812   return res;
6813 }
6814
6815
6816 //==========================================================================
6817 //
6818 //  ufoCondDefine
6819 //
6820 //==========================================================================
6821 void ufoCondDefine (const char *name) {
6822   if (name != NULL && name[0] != 0) {
6823     const size_t nlen = strlen(name);
6824     if (nlen > 255) ufoFatal("conditional define name too long");
6825     const uint32_t hash = joaatHashBufCI(name, nlen);
6826     UForthCondDefine *dd = ufoCondDefines;
6827     int res = 0;
6828     while (res == 0 && dd != NULL) {
6829       if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
6830         res = ufoStrEquCI(name, dd->name);
6831       }
6832       dd = dd->next;
6833     }
6834     if (res == 0) {
6835       // new define
6836       dd = calloc(1, sizeof(UForthCondDefine));
6837       if (dd == NULL) ufoFatal("out of memory for defines");
6838       dd->name = strdup(name);
6839       if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
6840       dd->namelen = (uint32_t)nlen;
6841       dd->hash = hash;
6842       dd->next = ufoCondDefines;
6843       ufoCondDefines = dd;
6844     }
6845   }
6846 }
6847
6848
6849 //==========================================================================
6850 //
6851 //  ufoCondUndef
6852 //
6853 //==========================================================================
6854 void ufoCondUndef (const char *name) {
6855   if (name != NULL && name[0] != 0) {
6856     const size_t nlen = strlen(name);
6857     if (nlen <= 255) {
6858       const uint32_t hash = joaatHashBufCI(name, nlen);
6859       UForthCondDefine *dd = ufoCondDefines;
6860       UForthCondDefine *prev = NULL;
6861       while (dd != NULL) {
6862         if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
6863           if (ufoStrEquCI(name, dd->name)) {
6864             if (prev != NULL) prev->next = dd->next; else ufoCondDefines = dd->next;
6865             free(dd->name);
6866             free(dd);
6867             dd = NULL;
6868           }
6869         }
6870         if (dd != NULL) { prev = dd; dd = dd->next; }
6871       }
6872     }
6873   }
6874 }
6875
6876
6877 // ($DEFINE)
6878 // ( addr count -- )
6879 UFWORD(PAR_DLR_DEFINE) {
6880   uint32_t count = ufoPop();
6881   uint32_t addr = ufoPop();
6882   if (count == 0) ufoFatal("empty define");
6883   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
6884   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
6885   UForthCondDefine *dd;
6886   for (dd = ufoCondDefines; dd != NULL; dd = dd->next) {
6887     if (dd->hash == hash && dd->namelen == count) {
6888       if (ufoBufEquCI(addr, count, dd->name)) return;
6889     }
6890   }
6891   // new define
6892   dd = calloc(1, sizeof(UForthCondDefine));
6893   if (dd == NULL) ufoFatal("out of memory for defines");
6894   dd->name = calloc(1, count + 1u);
6895   if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
6896   for (uint32_t f = 0; f < count; f += 1) {
6897     ((unsigned char *)dd->name)[f] = ufoImgGetU8(addr + f);
6898   }
6899   dd->namelen = count;
6900   dd->hash = hash;
6901   dd->next = ufoCondDefines;
6902   ufoCondDefines = dd;
6903 }
6904
6905 // ($UNDEF)
6906 // ( addr count -- )
6907 UFWORD(PAR_DLR_UNDEF) {
6908   uint32_t count = ufoPop();
6909   uint32_t addr = ufoPop();
6910   if (count == 0) ufoFatal("empty define");
6911   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
6912   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
6913   UForthCondDefine *prev = NULL;
6914   UForthCondDefine *dd;
6915   for (dd = ufoCondDefines; dd != NULL; prev = dd, dd = dd->next) {
6916     if (dd->hash == hash && dd->namelen == count) {
6917       if (ufoBufEquCI(addr, count, dd->name)) {
6918         if (prev == NULL) ufoCondDefines = dd->next; else prev->next = dd->next;
6919         free(dd->name);
6920         free(dd);
6921         return;
6922       }
6923     }
6924   }
6925 }
6926
6927 // ($DEFINED?)
6928 // ( addr count -- bool )
6929 UFWORD(PAR_DLR_DEFINEDQ) {
6930   uint32_t count = ufoPop();
6931   uint32_t addr = ufoPop();
6932   if (count == 0) ufoFatal("empty define");
6933   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
6934   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
6935   int found = 0;
6936   UForthCondDefine *dd = ufoCondDefines;
6937   while (!found && dd != NULL) {
6938     if (dd->hash == hash && dd->namelen == count) {
6939       found = ufoBufEquCI(addr, count, dd->name);
6940     }
6941     dd = dd->next;
6942   }
6943   ufoPushBool(found);
6944 }
6945
6946
6947 // ////////////////////////////////////////////////////////////////////////// //
6948 // error reporting
6949 //
6950
6951 // ERROR
6952 // ( addr count -- )
6953 UFWORD(ERROR) {
6954   uint32_t count = ufoPop();
6955   uint32_t addr = ufoPop();
6956   if (count & (1u<<31)) ufoFatal("invalid error message");
6957   if (count == 0) ufoFatal("some error");
6958   if (count > (uint32_t)sizeof(ufoErrMsgBuf) - 1u) count = (uint32_t)sizeof(ufoErrMsgBuf) - 1u;
6959   for (uint32_t f = 0; f < count; f += 1) {
6960     ufoErrMsgBuf[f] = (char)ufoImgGetU8(addr + f);
6961   }
6962   ufoErrMsgBuf[count] = 0;
6963   ufoFatal("%s", ufoErrMsgBuf);
6964 }
6965
6966 // (USER-ABORT)
6967 UFWORD(PAR_USER_ABORT) {
6968   ufoFatal("user abort");
6969 }
6970
6971 // ?ERROR
6972 // ( errflag addr count -- )
6973 UFWORD(QERROR) {
6974   UFO_STACK(3);
6975   if (UFO_S(2)) {
6976     UFCALL(ERROR);
6977   } else {
6978     ufoSP -= 3u;
6979   }
6980 }
6981
6982 // ?NOT-ERROR
6983 // ( errflag addr count -- )
6984 UFWORD(QNOTERROR) {
6985   UFO_STACK(3);
6986   if (UFO_S(2) == 0) {
6987     UFCALL(ERROR);
6988   } else {
6989     ufoSP -= 3u;
6990   }
6991 }
6992
6993
6994 // ////////////////////////////////////////////////////////////////////////// //
6995 // includes
6996 //
6997
6998 static char ufoFNameBuf[4096];
6999
7000
7001 //==========================================================================
7002 //
7003 //  ufoScanIncludeFileName
7004 //
7005 //  `*psys` and `*psoft` must be initialised!
7006 //
7007 //==========================================================================
7008 static void ufoScanIncludeFileName (uint32_t addr, uint32_t count, char *dest, size_t destsz,
7009                                     uint32_t *psys, uint32_t *psoft)
7010 {
7011   uint8_t ch;
7012   uint32_t dpos;
7013   ufo_assert(dest != NULL);
7014   ufo_assert(destsz > 0);
7015
7016   while (count != 0) {
7017     ch = ufoImgGetU8(addr);
7018     if (ch == '!') {
7019       //if (system) ufoFatal("invalid file name (duplicate system mark)");
7020       *psys = 1;
7021     } else if (ch == '?') {
7022       //if (softinclude) ufoFatal("invalid file name (duplicate soft mark)");
7023       *psoft = 1;
7024     } else {
7025       break;
7026     }
7027     do {
7028       addr += 1; count -= 1;
7029       ch = ufoImgGetU8(addr);
7030     } while (ch <= 32 && count != 0);
7031   }
7032
7033   if (count == 0) ufoFatal("empty include file name");
7034   if (count >= destsz) ufoFatal("include file name too long");
7035
7036   dpos = 0;
7037   while (count != 0) {
7038     dest[dpos] = (char)ufoImgGetU8(addr); dpos += 1;
7039     addr += 1; count -= 1;
7040   }
7041   dest[dpos] = 0;
7042 }
7043
7044
7045 // (INCLUDE-LINE-FOFS)
7046 // ( -- fofs )
7047 UFWORD(PAR_INCLUDE_LINE_FOFS) {
7048   ufoPush((uint32_t)(int32_t)ufoCurrIncludeLineFileOfs);
7049 }
7050
7051 // (INCLUDE-LINE-SEEK)
7052 // ( lidx fofs -- )
7053 UFWORD(PAR_INCLUDE_LINE_SEEK) {
7054   uint32_t fofs = ufoPop();
7055   uint32_t lidx = ufoPop();
7056   if (lidx >= 0x0fffffffU) lidx = 0;
7057   if (ufoInFile == NULL) ufoFatal("cannot seek without opened include file");
7058   if (fseek(ufoInFile, (long)fofs, SEEK_SET) != 0) {
7059     ufoFatal("error seeking in include file");
7060   }
7061   ufoInFileLine = lidx;
7062 }
7063
7064 // (INCLUDE-DEPTH)
7065 // ( -- depth )
7066 // return number of items in include stack
7067 UFWORD(PAR_INCLUDE_DEPTH) {
7068   ufoPush(ufoFileStackPos);
7069 }
7070
7071 // (INCLUDE-FILE-ID)
7072 // ( isp -- id ) -- isp 0 is current, then 1, etc.
7073 // each include file has unique non-zero id.
7074 UFWORD(PAR_INCLUDE_FILE_ID) {
7075   const uint32_t isp = ufoPop();
7076   if (isp == 0) {
7077     ufoPush(ufoFileId);
7078   } else if (isp <= ufoFileStackPos) {
7079     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
7080     ufoPush(stk->id);
7081   } else {
7082     ufoFatal("invalid include stack index");
7083   }
7084 }
7085
7086 // (INCLUDE-FILE-LINE)
7087 // ( isp -- line )
7088 UFWORD(PAR_INCLUDE_FILE_LINE) {
7089   const uint32_t isp = ufoPop();
7090   if (isp == 0) {
7091     ufoPush(ufoInFileLine);
7092   } else if (isp <= ufoFileStackPos) {
7093     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
7094     ufoPush(stk->fline);
7095   } else {
7096     ufoFatal("invalid include stack index");
7097   }
7098 }
7099
7100 // (INCLUDE-FILE-NAME)
7101 // ( isp -- addr count )
7102 // current file name; at PAD
7103 UFWORD(PAR_INCLUDE_FILE_NAME) {
7104   const uint32_t isp = ufoPop();
7105   const char *fname = NULL;
7106   if (isp == 0) {
7107     fname = ufoInFileName;
7108   } else if (isp <= ufoFileStackPos) {
7109     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
7110     fname = stk->fname;
7111   } else {
7112     ufoFatal("invalid include stack index");
7113   }
7114   uint32_t addr = UFO_PAD_ADDR + 4u;
7115   uint32_t count = 0;
7116   if (fname != NULL) {
7117     while (fname[count] != 0) {
7118       ufoImgPutU8(addr + count, ((const unsigned char *)fname)[count]);
7119       count += 1;
7120     }
7121   }
7122   ufoImgPutU32(addr - 4u, count);
7123   ufoImgPutU8(addr + count, 0);
7124   ufoPush(addr);
7125   ufoPush(count);
7126 }
7127
7128
7129 // (INCLUDE-BUILD-NAME)
7130 // ( addr count soft? system? -- addr count )
7131 // to PAD
7132 UFWORD(PAR_INCLUDE_BUILD_NAME) {
7133   uint32_t system = ufoPop();
7134   uint32_t softinclude = ufoPop();
7135   uint32_t count = ufoPop();
7136   uint32_t addr = ufoPop();
7137
7138   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid include name");
7139
7140   ufoScanIncludeFileName(addr, count, ufoFNameBuf, sizeof(ufoFNameBuf),
7141                          &system, &softinclude);
7142
7143   char *ffn = ufoCreateIncludeName(ufoFNameBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
7144   addr = UFO_PAD_ADDR + 4u;
7145   count = 0;
7146   while (ffn[count] != 0) {
7147     ufoImgPutU8(addr + count, ((const unsigned char *)ffn)[count]);
7148     count += 1u;
7149   }
7150   free(ffn);
7151   ufoImgPutU8(addr + count, 0);
7152   ufoImgPutU32(addr - 4u, count);
7153   ufoPush(addr);
7154   ufoPush(count);
7155 }
7156
7157 // (INCLUDE-NO-REFILL)
7158 // ( addr count soft? system? -- )
7159 UFWORD(PAR_INCLUDE_NO_REFILL) {
7160   uint32_t system = ufoPop();
7161   uint32_t softinclude = ufoPop();
7162   uint32_t count = ufoPop();
7163   uint32_t addr = ufoPop();
7164
7165   if (ufoMode == UFO_MODE_MACRO) ufoFatal("macros cannot include files");
7166
7167   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid include name");
7168
7169   ufoScanIncludeFileName(addr, count, ufoFNameBuf, sizeof(ufoFNameBuf),
7170                          &system, &softinclude);
7171
7172   char *ffn = ufoCreateIncludeName(ufoFNameBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
7173   #ifdef WIN32
7174   FILE *fl = fopen(ffn, "rb");
7175   #else
7176   FILE *fl = fopen(ffn, "r");
7177   #endif
7178   if (!fl) {
7179     if (softinclude) { free(ffn); return; }
7180     ufoFatal("include file '%s' not found", ffn);
7181   }
7182   #ifdef UFO_DEBUG_INCLUDE
7183   fprintf(stderr, "INC-PUSH: new fname: %s\n", ffn);
7184   #endif
7185   ufoPushInFile();
7186   ufoInFile = fl;
7187   ufoInFileLine = 0;
7188   ufoSetInFileNameReuse(ffn);
7189   ufoFileId = ufoLastUsedFileId;
7190   setLastIncPath(ufoInFileName, system);
7191 }
7192
7193 // (INCLUDE-DROP)
7194 // ( -- )
7195 UFWORD(PAR_INCLUDE_DROP) {
7196   ufoPopInFile();
7197 }
7198
7199 // (INCLUDE)
7200 // ( addr count soft? system? -- )
7201 UFWORD(PAR_INCLUDE) {
7202   UFCALL(PAR_INCLUDE_NO_REFILL);
7203   // trigger next line loading
7204   UFCALL(REFILL);
7205   if (!ufoPop()) ufoFatal("(INCLUDE) internal error");
7206 }
7207
7208 // $INCLUDE "str"
7209 UFWORD(DLR_INCLUDE_IMM) {
7210   int soft = 0, system = 0;
7211   // parse include filename
7212   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
7213   uint8_t ch = ufoTibPeekCh();
7214   if (ch == '"') {
7215     ufoTibSkipCh(); // skip quote
7216     ufoPush(34);
7217   } else if (ch == '<') {
7218     ufoTibSkipCh(); // skip quote
7219     ufoPush(62);
7220     system = 1;
7221   } else {
7222     ufoFatal("expected quoted string");
7223   }
7224   UFCALL(PARSE);
7225   if (!ufoPop()) ufoFatal("file name expected");
7226   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
7227   if (ufoTibPeekCh() != 0) {
7228     ufoFatal("$INCLUDE doesn't accept extra args yet");
7229   }
7230   // ( addr count soft? system? -- )
7231   ufoPushBool(soft); ufoPushBool(system); UFCALL(PAR_INCLUDE);
7232 }
7233
7234
7235 //==========================================================================
7236 //
7237 //  ufoCreateFileGuard
7238 //
7239 //==========================================================================
7240 static const char *ufoCreateFileGuard (const char *fname) {
7241   if (fname == NULL || fname[0] == 0) return NULL;
7242   char *rp = ufoRealPath(fname);
7243   if (rp == NULL) return NULL;
7244   #ifdef WIN32
7245   for (char *s = rp; *s; s += 1) if (*s == '\\') *s = '/';
7246   #endif
7247   // hash the buffer; extract file name; create string with path len, file name, and hash
7248   const size_t orgplen = strlen(rp);
7249   const uint32_t phash = joaatHashBuf(rp, orgplen, 0);
7250   size_t plen = orgplen;
7251   while (plen != 0 && rp[plen - 1u] != '/') plen -= 1;
7252   snprintf(ufoRealPathHashBuf, sizeof(ufoRealPathHashBuf),
7253            "__INCLUDE_GUARD_%08X_%08X_%s__", phash, (uint32_t)orgplen, rp + plen);
7254   return ufoRealPathHashBuf;
7255 }
7256
7257
7258 // $INCLUDE-ONCE "str"
7259 // includes file only once; unreliable on shitdoze, i believe
7260 UFWORD(DLR_INCLUDE_ONCE_IMM) {
7261   uint32_t softinclude = 0, system = 0;
7262   // parse include filename
7263   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
7264   uint8_t ch = ufoTibPeekCh();
7265   if (ch == '"') {
7266     ufoTibSkipCh(); // skip quote
7267     ufoPush(34);
7268   } else if (ch == '<') {
7269     ufoTibSkipCh(); // skip quote
7270     ufoPush(62);
7271     system = 1;
7272   } else {
7273     ufoFatal("expected quoted string");
7274   }
7275   UFCALL(PARSE);
7276   if (!ufoPop()) ufoFatal("file name expected");
7277   const uint32_t count = ufoPop();
7278   const uint32_t addr = ufoPop();
7279   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
7280   if (ufoTibPeekCh() != 0) {
7281     ufoFatal("$REQUIRE doesn't accept extra args yet");
7282   }
7283   ufoScanIncludeFileName(addr, count, ufoRealPathHashBuf, sizeof(ufoRealPathHashBuf),
7284                          &system, &softinclude);
7285   char *incfname = ufoCreateIncludeName(ufoRealPathHashBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
7286   if (incfname == NULL) ufoFatal("cannot resolve include file '%s'", ufoRealPathHashBuf);
7287   //fprintf(stderr, "?:%d;!:%d;%s|%s\n", softinclude, system, ufoRealPathHashBuf, incfname);
7288   // this will overwrite `ufoRealPathHashBuf`
7289   const char *guard = ufoCreateFileGuard(incfname);
7290   free(incfname);
7291   if (guard == NULL) {
7292     if (!softinclude) ufoFatal("cannot include file '%s'", ufoRealPathHashBuf);
7293     return;
7294   }
7295   #if 0
7296   fprintf(stderr, "GUARD: <%s>\n", guard);
7297   #endif
7298   // now check for the guard
7299   const uint32_t glen = (uint32_t)strlen(guard);
7300   const uint32_t ghash = joaatHashBuf(guard, glen, 0);
7301   UForthCondDefine *dd;
7302   for (dd = ufoCondDefines; dd != NULL; dd = dd->next) {
7303     if (dd->hash == ghash && dd->namelen == glen && strcmp(guard, dd->name) == 0) {
7304       // nothing to do: already included
7305       return;
7306     }
7307   }
7308   // add guard
7309   dd = calloc(1, sizeof(UForthCondDefine));
7310   if (dd == NULL) ufoFatal("out of memory for defines");
7311   dd->name = calloc(1, glen + 1u);
7312   if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
7313   strcpy(dd->name, guard);
7314   dd->namelen = glen;
7315   dd->hash = ghash;
7316   dd->next = ufoCondDefines;
7317   ufoCondDefines = dd;
7318   // ( addr count soft? system? -- )
7319   ufoPush(addr); ufoPush(count); ufoPushBool(softinclude); ufoPushBool(system);
7320   UFCALL(PAR_INCLUDE);
7321 }
7322
7323
7324 // ////////////////////////////////////////////////////////////////////////// //
7325 // handles
7326 //
7327
7328 // HANDLE:NEW
7329 // ( typeid -- hx )
7330 UFWORD(PAR_NEW_HANDLE) {
7331   const uint32_t typeid = ufoPop();
7332   if (typeid == UFO_HANDLE_FREE) ufoFatal("invalid handle typeid");
7333   UfoHandle *hh = ufoAllocHandle(typeid);
7334   ufoPush(hh->ufoHandle);
7335 }
7336
7337 // HANDLE:FREE
7338 // ( hx -- )
7339 UFWORD(PAR_FREE_HANDLE) {
7340   const uint32_t hx = ufoPop();
7341   if (hx != 0) {
7342     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("trying to free something that is not a handle");
7343     UfoHandle *hh = ufoGetHandle(hx);
7344     if (hh == NULL) ufoFatal("trying to free invalid handle");
7345     ufoFreeHandle(hh);
7346   }
7347 }
7348
7349 // HANDLE:TYPEID@
7350 // ( hx -- typeid )
7351 UFWORD(PAR_HANDLE_GET_TYPEID) {
7352   const uint32_t hx = ufoPop();
7353   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
7354   UfoHandle *hh = ufoGetHandle(hx);
7355   if (hh == NULL) ufoFatal("invalid handle");
7356   ufoPush(hh->typeid);
7357 }
7358
7359 // HANDLE:TYPEID!
7360 // ( typeid hx -- )
7361 UFWORD(PAR_HANDLE_SET_TYPEID) {
7362   const uint32_t hx = ufoPop();
7363   const uint32_t typeid = ufoPop();
7364   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
7365   if (typeid == UFO_HANDLE_FREE) ufoFatal("invalid handle typeid");
7366   UfoHandle *hh = ufoGetHandle(hx);
7367   if (hh == NULL) ufoFatal("invalid handle");
7368   hh->typeid = typeid;
7369 }
7370
7371 // HANDLE:SIZE@
7372 // ( hx -- size )
7373 UFWORD(PAR_HANDLE_GET_SIZE) {
7374   const uint32_t hx = ufoPop();
7375   if (hx != 0) {
7376     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
7377     UfoHandle *hh = ufoGetHandle(hx);
7378     if (hh == NULL) ufoFatal("invalid handle");
7379     ufoPush(hh->size);
7380   } else {
7381     ufoPush(0);
7382   }
7383 }
7384
7385 // HANDLE:SIZE!
7386 // ( size hx -- )
7387 UFWORD(PAR_HANDLE_SET_SIZE) {
7388   const uint32_t hx = ufoPop();
7389   const uint32_t size = ufoPop();
7390   if (size > 0x04000000) ufoFatal("invalid handle size");
7391   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
7392   UfoHandle *hh = ufoGetHandle(hx);
7393   if (hh == NULL) ufoFatal("invalid handle");
7394   if (hh->size != size) {
7395     if (size == 0) {
7396       free(hh->data);
7397       hh->data = NULL;
7398     } else {
7399       uint8_t *nx = realloc(hh->data, size * sizeof(hh->data[0]));
7400       if (nx == NULL) ufoFatal("out of memory for handle of size %u", size);
7401       hh->data = nx;
7402       if (size > hh->size) memset(hh->data, 0, size - hh->size);
7403     }
7404     hh->size = size;
7405     if (hh->used > size) hh->used = size;
7406   }
7407 }
7408
7409 // HANDLE:USED@
7410 // ( hx -- used )
7411 UFWORD(PAR_HANDLE_GET_USED) {
7412   const uint32_t hx = ufoPop();
7413   if (hx != 0) {
7414     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
7415     UfoHandle *hh = ufoGetHandle(hx);
7416     if (hh == NULL) ufoFatal("invalid handle");
7417     ufoPush(hh->used);
7418   } else {
7419     ufoPush(0);
7420   }
7421 }
7422
7423 // HANDLE:USED!
7424 // ( size hx -- )
7425 UFWORD(PAR_HANDLE_SET_USED) {
7426   const uint32_t hx = ufoPop();
7427   const uint32_t used = ufoPop();
7428   if (used > 0x04000000) ufoFatal("invalid handle used");
7429   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
7430   UfoHandle *hh = ufoGetHandle(hx);
7431   if (hh == NULL) ufoFatal("invalid handle");
7432   if (used > hh->size) ufoFatal("handle used %u out of range (%u)", used, hh->size);
7433   hh->used = used;
7434 }
7435
7436 #define POP_PREPARE_HANDLE() \
7437   const uint32_t hx = ufoPop(); \
7438   uint32_t idx = ufoPop()
7439
7440
7441 // HANDLE:C@
7442 // ( idx hx -- value )
7443 UFWORD(PAR_HANDLE_LOAD_BYTE) {
7444   POP_PREPARE_HANDLE();
7445   ufoPush(ufoHandleLoadByte(hx, idx));
7446 }
7447
7448 // HANDLE:W@
7449 // ( idx hx -- value )
7450 UFWORD(PAR_HANDLE_LOAD_WORD) {
7451   POP_PREPARE_HANDLE();
7452   ufoPush(ufoHandleLoadWord(hx, idx));
7453 }
7454
7455 // HANDLE:@
7456 // ( idx hx -- value )
7457 UFWORD(PAR_HANDLE_LOAD_CELL) {
7458   POP_PREPARE_HANDLE();
7459   ufoPush(ufoHandleLoadCell(hx, idx));
7460 }
7461
7462 // HANDLE:C!
7463 // ( value idx hx -- value )
7464 UFWORD(PAR_HANDLE_STORE_BYTE) {
7465   POP_PREPARE_HANDLE();
7466   const uint32_t value = ufoPop();
7467   ufoHandleStoreByte(hx, idx, value);
7468 }
7469
7470 // HANDLE:W!
7471 // ( value idx hx -- )
7472 UFWORD(PAR_HANDLE_STORE_WORD) {
7473   POP_PREPARE_HANDLE();
7474   const uint32_t value = ufoPop();
7475   ufoHandleStoreWord(hx, idx, value);
7476 }
7477
7478 // HANDLE:!
7479 // ( value idx hx -- )
7480 UFWORD(PAR_HANDLE_STORE_CELL) {
7481   POP_PREPARE_HANDLE();
7482   const uint32_t value = ufoPop();
7483   ufoHandleStoreCell(hx, idx, value);
7484 }
7485
7486
7487 // HANDLE:LOAD-FILE
7488 // ( addr count -- stx / FALSE )
7489 UFWORD(PAR_HANDLE_LOAD_FILE) {
7490   uint32_t count = ufoPop();
7491   uint32_t addr = ufoPop();
7492
7493   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid file name");
7494
7495   uint8_t *dest = (uint8_t *)ufoFNameBuf;
7496   while (count != 0 && dest < (uint8_t *)ufoFNameBuf + sizeof(ufoFNameBuf)) {
7497     uint8_t ch = ufoImgGetU8(addr);
7498     *dest = ch;
7499     dest += 1u; addr += 1u; count -= 1u;
7500   }
7501   if (dest == (uint8_t *)ufoFNameBuf + sizeof(ufoFNameBuf)) ufoFatal("file name too long");
7502   *dest = 0;
7503
7504   if (*ufoFNameBuf == 0) ufoFatal("empty file name");
7505
7506   char *ffn = ufoCreateIncludeName(ufoFNameBuf, 0/*system*/, ufoLastIncPath);
7507   #ifdef WIN32
7508   FILE *fl = fopen(ffn, "rb");
7509   #else
7510   FILE *fl = fopen(ffn, "r");
7511   #endif
7512   if (!fl) {
7513     free(ffn);
7514     ufoPush(0);
7515     return;
7516   }
7517
7518   if (fseek(fl, 0, SEEK_END) != 0) {
7519     fclose(fl);
7520     ufoFatal("seek error in file '%s'", ffn);
7521   }
7522
7523   long sz = ftell(fl);
7524   if (sz < 0 || sz >= 1024 * 1024 * 64) {
7525     fclose(fl);
7526     ufoFatal("tell error in file '%s' (or too big)", ffn);
7527   }
7528
7529   if (fseek(fl, 0, SEEK_SET) != 0) {
7530     fclose(fl);
7531     ufoFatal("seek error in file '%s'", ffn);
7532   }
7533
7534   UfoHandle *hh = ufoAllocHandle(0);
7535   if (sz != 0) {
7536     hh->data = malloc((uint32_t)sz);
7537     if (hh->data == NULL) {
7538       fclose(fl);
7539       ufoFatal("out of memory for file '%s'", ffn);
7540     }
7541     hh->size = (uint32_t)sz;
7542     if (fread(hh->data, (uint32_t)sz, 1, fl) != 1) {
7543       fclose(fl);
7544       ufoFatal("error reading file '%s'", ffn);
7545     }
7546     fclose(fl);
7547   }
7548
7549   free(ffn);
7550   ufoPush(hh->ufoHandle);
7551 }
7552
7553
7554 // ////////////////////////////////////////////////////////////////////////// //
7555 // utils
7556 //
7557
7558 #ifdef UFO_MTASK_ALLOWED
7559 #define UFO_MTASK_POP_STATE()  \
7560   UfoState *st = ufoFindState(ufoPop()); \
7561   if (st == NULL) ufoFatal("unknown state")
7562 #else
7563 #define UFO_MTASK_POP_STATE()  \
7564   if (ufoPop() != 0) ufoFatal("no multitasking support compiled in"); \
7565   UfoState *st = &ufoCurrState
7566 #endif
7567
7568 // DEBUG:(DECOMPILE-CFA)
7569 // ( cfa -- )
7570 UFWORD(DEBUG_DECOMPILE_CFA) {
7571   const uint32_t cfa = ufoPop();
7572   ufoFlushOutput();
7573   ufoDecompileWord(cfa);
7574 }
7575
7576 // DEBUG:(DECOMPILE-MEM)
7577 // ( addr-start addr-end -- )
7578 UFWORD(DEBUG_DECOMPILE_MEM) {
7579   const uint32_t end = ufoPop();
7580   const uint32_t start = ufoPop();
7581   ufoFlushOutput();
7582   ufoDecompilePart(start, end, 0);
7583 }
7584
7585 // GET-MSECS
7586 // ( -- u32 )
7587 UFWORD(GET_MSECS) {
7588   ufoPush((uint32_t)ufo_get_msecs());
7589 }
7590
7591 // this is called by INTERPRET when it is out of input stream
7592 UFWORD(UFO_INTERPRET_FINISHED_ACTION) {
7593   longjmp(ufoStopVMJP, 666);
7594 }
7595
7596 #ifdef UFO_MTASK_ALLOWED
7597 // MTASK:NEW-STATE
7598 // ( cfa -- stid )
7599 UFWORD(MT_NEW_STATE) {
7600   UfoState *st = ufoNewState();
7601   const uint32_t cfa = ufoPop();
7602   const uint32_t cfaidx = ufoImgGetU32(cfa);
7603   if (cfaidx != ufoDoForthCFA) ufoFatal("state starting word should be in Forth");
7604   ufoInitStateUserVars(st);
7605   st->ip = UFO_CFA_TO_PFA(cfa);
7606   st->rStack[0] = 0xdeadf00d; // dummy value
7607   st->RP = 1;
7608   ufoPush(st->id);
7609 }
7610
7611 // MTASK:FREE-STATE
7612 // ( stid -- )
7613 UFWORD(MT_FREE_STATE) {
7614   UfoState *st = ufoFindState(ufoPop());
7615   if (st == NULL) ufoFatal("cannot free unknown state");
7616   if (st == ufoCurrState) ufoFatal("cannot free current state");
7617   ufoFreeState(st);
7618 }
7619 #endif
7620
7621 // MTASK:STATE-NAME@
7622 // ( stid -- addr count )
7623 // to PAD
7624 UFWORD(MT_GET_STATE_NAME) {
7625   UFO_MTASK_POP_STATE();
7626   uint32_t addr = UFO_PAD_ADDR;
7627   uint32_t count = 0;
7628   while (st->name[count] != 0) {
7629     ufoImgPutU8(addr + count, ((const unsigned char *)st->name)[count]);
7630     count += 1u;
7631   }
7632   ufoImgPutU8(addr + count, 0);
7633   ufoPush(addr);
7634   ufoPush(count);
7635 }
7636
7637 // MTASK:STATE-NAME!
7638 // ( addr count stid -- )
7639 UFWORD(MT_SET_STATE_NAME) {
7640   UFO_MTASK_POP_STATE();
7641   uint32_t count = ufoPop();
7642   uint32_t addr = ufoPop();
7643   if ((count & ((uint32_t)1 << 31)) == 0) {
7644     if (count > UFO_MAX_TASK_NAME) ufoFatal("task name too long");
7645     for (uint32_t f = 0; f < count; f += 1u) {
7646       ((unsigned char *)st->name)[f] = ufoImgGetU8(addr + f);
7647     }
7648     st->name[count] = 0;
7649   }
7650 }
7651
7652 #ifdef UFO_MTASK_ALLOWED
7653 // MTASK:STATE-FIRST
7654 // ( -- stid )
7655 UFWORD(MT_STATE_FIRST) {
7656   uint32_t fidx = 0;
7657   while (fidx != (uint32_t)(UFO_MAX_STATES/32) && ufoStateUsedBitmap[fidx] == 0) fidx += 1u;
7658   // there should be at least one allocated state
7659   ufo_assert(fidx != (uint32_t)(UFO_MAX_STATES/32));
7660   uint32_t bmp = ufoStateUsedBitmap[fidx];
7661   fidx *= 32u;
7662   while ((bmp & 0x01) == 0) { fidx += 1u; bmp >>= 1; }
7663   ufoPush(fidx + 1u);
7664 }
7665
7666 // MTASK:STATE-NEXT
7667 // ( stid -- stid / 0 )
7668 UFWORD(MT_STATE_NEXT) {
7669   uint32_t stid = ufoPop();
7670   if (stid != 0 && stid < (uint32_t)(UFO_MAX_STATES/32)) {
7671     // it is already incremented for us, yay!
7672     uint32_t fidx = stid / 32u;
7673     uint8_t fofs = stid & 0x1f;
7674     while (fidx < (uint32_t)(UFO_MAX_STATES/32)) {
7675       const uint32_t bmp = ufoStateUsedBitmap[fidx];
7676       if (bmp != 0) {
7677         while (fofs != 32u) {
7678           if ((bmp & ((uint32_t)1 << (fofs & 0x1f))) == 0) fofs += 1u;
7679         }
7680         if (fofs != 32u) {
7681           ufoPush(fidx * 32u + fofs + 1u);
7682           return; // sorry!
7683         }
7684       }
7685       fidx += 1u; fofs = 0;
7686     }
7687   }
7688   ufoPush(0);
7689 }
7690
7691 // MTASK:YIELD-TO
7692 // ( ... argc stid -- )
7693 UFWORD(MT_YIELD_TO) {
7694   UfoState *st = ufoFindState(ufoPop());
7695   if (st == NULL) ufoFatal("cannot yield to unknown state");
7696   //if (st == ufoDebuggerState) ufoFatal("cannot yield to debugger"); // why not?
7697   const uint32_t argc = ufoPop();
7698   if (argc > 256) ufoFatal("too many YIELD-TO arguments");
7699   UfoState *curst = ufoCurrState;
7700   if (st != ufoCurrState) {
7701     for (uint32_t f = 0; f < argc; f += 1) {
7702       ufoCurrState = curst;
7703       const uint32_t n = ufoPop();
7704       ufoCurrState = st;
7705       ufoPush(n);
7706     }
7707     ufoCurrState = curst; // we need to use API call to switch states
7708   }
7709   ufoSwitchToState(st); // always use API call for this!
7710   ufoPush(argc);
7711   ufoPush(curst->id);
7712 }
7713
7714 // MTASK:SET-SELF-AS-DEBUGGER
7715 // ( -- )
7716 UFWORD(MT_SET_SELF_AS_DEBUGGER) {
7717   ufoDebuggerState = ufoCurrState;
7718 }
7719
7720 // DEBUG:SINGLE-STEP@
7721 // ( -- enabled? )
7722 UFWORD(DBG_GET_SS) {
7723   ufoPush(ufoSingleStepAllowed);
7724 }
7725 #endif
7726
7727 // DEBUG:(BP)
7728 // ( -- )
7729 // debugger task receives debugge stid on the data stack, and -1 as argc.
7730 // i.e. debugger stask is: ( -1 old-stid )
7731 UFWORD(MT_DEBUGGER_BP) {
7732   #ifdef UFO_MTASK_ALLOWED
7733   if (ufoDebuggerState != NULL && ufoCurrState != ufoDebuggerState && ufoIsGoodTTY()) {
7734     UfoState *st = ufoCurrState;
7735     ufoSwitchToState(ufoDebuggerState); // always use API call for this!
7736     ufoPush(-1);
7737     ufoPush(st->id);
7738     ufoSingleStep = 0;
7739   } else {
7740     UFCALL(UFO_BACKTRACE);
7741   }
7742   #else
7743   UFCALL(UFO_BACKTRACE);
7744   #endif
7745 }
7746
7747 #ifdef UFO_MTASK_ALLOWED
7748 // MTASK:DEBUGGER-RESUME
7749 // ( stid -- )
7750 UFWORD(MT_RESUME_DEBUGEE) {
7751   if (ufoCurrState != ufoDebuggerState) ufoFatal("cannot resume from non-debugger");
7752   UfoState *st = ufoFindState(ufoPop());
7753   if (st == NULL) ufoFatal("cannot yield to unknown state");
7754   if (st == ufoCurrState) ufoFatal("cannot resume into debugger itself");
7755   ufoSwitchToState(st); // always use API call for this!
7756   ufoSingleStep = 0;
7757 }
7758
7759 // MTASK:DEBUGGER-SINGLE-STEP
7760 // ( stid -- )
7761 UFWORD(MT_SINGLE_STEP_DEBUGEE) {
7762   if (ufoCurrState != ufoDebuggerState) ufoFatal("cannot resume from non-debugger");
7763   UfoState *st = ufoFindState(ufoPop());
7764   if (st == NULL) ufoFatal("cannot yield to unknown state");
7765   if (st == ufoCurrState) ufoFatal("cannot resume into debugger itself");
7766   ufoSwitchToState(st); // always use API call for this!
7767   ufoSingleStep = 2; // it will be decremented after returning from this word
7768 }
7769 #endif
7770
7771 // MTASK:STATE-IP@
7772 // ( stid -- ip )
7773 UFWORD(MT_STATE_IP_GET) {
7774   UFO_MTASK_POP_STATE();
7775   ufoPush(st->IP);
7776 }
7777
7778 // MTASK:STATE-IP!
7779 // ( ip stid -- )
7780 UFWORD(MT_STATE_IP_SET) {
7781   UFO_MTASK_POP_STATE();
7782   st->IP = ufoPop();
7783 }
7784
7785 // MTASK:STATE-A>
7786 // ( stid -- ip )
7787 UFWORD(MT_STATE_REGA_GET) {
7788   UFO_MTASK_POP_STATE();
7789   ufoPush(st->regA);
7790 }
7791
7792 // MTASK:STATE->A
7793 // ( ip stid -- )
7794 UFWORD(MT_STATE_REGA_SET) {
7795   UFO_MTASK_POP_STATE();
7796   st->regA = ufoPop();
7797 }
7798
7799 // MTASK:STATE-USER@
7800 // ( addr stid -- value )
7801 UFWORD(MT_STATE_USER_GET) {
7802   UFO_MTASK_POP_STATE();
7803   const uint32_t addr = ufoPop();
7804   if ((addr & UFO_ADDR_TEMP_BIT) != 0 && (addr & UFO_ADDR_TEMP_MASK) + 3u < ufoSTImageTempSize(st)) {
7805     uint32_t v = *(const uint32_t *)((const uint8_t *)st->imageTemp + (addr & UFO_ADDR_TEMP_MASK));
7806     ufoPush(v);
7807   } else {
7808     ufoFatal("invalid user area address");
7809   }
7810 }
7811
7812 // MTASK:STATE-USER!
7813 // ( value addr stid -- )
7814 UFWORD(MT_STATE_USER_SET) {
7815   UFO_MTASK_POP_STATE();
7816   const uint32_t addr = ufoPop();
7817   const uint32_t value = ufoPop();
7818   if ((addr & UFO_ADDR_TEMP_BIT) != 0 && (addr & UFO_ADDR_TEMP_MASK) + 3u < ufoSTImageTempSize(st)) {
7819     *(uint32_t *)((const uint8_t *)st->imageTemp + (addr & UFO_ADDR_TEMP_MASK)) = value;
7820   } else {
7821     ufoFatal("invalid user area address");
7822   }
7823 }
7824
7825 // MTASK:ACTIVE-STATE
7826 // ( -- stid )
7827 UFWORD(MT_ACTIVE_STATE) {
7828   #ifdef UFO_MTASK_ALLOWED
7829   ufoPush(ufoCurrState->id);
7830   #else
7831   ufoPush(0);
7832   #endif
7833 }
7834
7835 // MTASK:YIELDED-FROM
7836 // ( -- stid / 0 )
7837 UFWORD(MT_YIELDED_FROM) {
7838   #ifdef UFO_MTASK_ALLOWED
7839   if (ufoYieldedState != NULL) {
7840     ufoPush(ufoYieldedState->id);
7841   } else {
7842     ufoPush(0);
7843   }
7844   #else
7845   ufoPush(0);
7846   #endif
7847 }
7848
7849 // MTASK:STATE-SP@
7850 // ( stid -- depth )
7851 UFWORD(MT_DSTACK_DEPTH_GET) {
7852   UFO_MTASK_POP_STATE();
7853   ufoPush(st->SP);
7854 }
7855
7856 // MTASK:STATE-RP@
7857 // ( stid -- depth )
7858 UFWORD(MT_RSTACK_DEPTH_GET) {
7859   UFO_MTASK_POP_STATE();
7860   ufoPush(st->RP);
7861 }
7862
7863 // MTASK:STATE-LP@
7864 // ( stid -- lp )
7865 UFWORD(MT_LP_GET) {
7866   UFO_MTASK_POP_STATE();
7867   ufoPush(st->LP);
7868 }
7869
7870 // MTASK:STATE-LBP@
7871 // ( stid -- lbp )
7872 UFWORD(MT_LBP_GET) {
7873   UFO_MTASK_POP_STATE();
7874   ufoPush(st->LBP);
7875 }
7876
7877 // MTASK:STATE-SP!
7878 // ( depth stid -- )
7879 UFWORD(MT_DSTACK_DEPTH_SET) {
7880   UFO_MTASK_POP_STATE();
7881   const uint32_t idx = ufoPop();
7882   if (idx >= UFO_DSTACK_SIZE) ufoFatal("invalid stack index %u (%u)", idx, UFO_DSTACK_SIZE);
7883   st->SP = idx;
7884 }
7885
7886 // MTASK:STATE-RP!
7887 // ( depth stid -- )
7888 UFWORD(MT_RSTACK_DEPTH_SET) {
7889   UFO_MTASK_POP_STATE();
7890   const uint32_t idx = ufoPop();
7891   const uint32_t left = UFO_RSTACK_SIZE;
7892   if (idx >= left) ufoFatal("invalid rstack index %u (%u)", idx, left);
7893   st->RP = idx;
7894 }
7895
7896 // MTASK:STATE-LP!
7897 // ( lp stid -- )
7898 UFWORD(MT_LP_SET) {
7899   UFO_MTASK_POP_STATE();
7900   st->LP = ufoPop();
7901 }
7902
7903 // MTASK:STATE-LBP!
7904 // ( lbp stid -- )
7905 UFWORD(MT_LBP_SET) {
7906   UFO_MTASK_POP_STATE();
7907   st->LBP = ufoPop();
7908 }
7909
7910 // MTASK:STATE-DS@
7911 // ( idx stid -- value )
7912 UFWORD(MT_DSTACK_LOAD) {
7913   UFO_MTASK_POP_STATE();
7914   const uint32_t idx = ufoPop();
7915   if (idx >= st->SP) ufoFatal("invalid stack index %u (%u)", idx, st->SP);
7916   ufoPush(st->dStack[st->SP - idx - 1u]);
7917 }
7918
7919 // MTASK:STATE-RS@
7920 // ( idx stid -- value )
7921 UFWORD(MT_RSTACK_LOAD) {
7922   UFO_MTASK_POP_STATE();
7923   const uint32_t idx = ufoPop();
7924   if (idx >= st->RP) ufoFatal("invalid stack index %u (%u)", idx, st->RP);
7925   ufoPush(st->dStack[st->RP - idx - 1u]);
7926 }
7927
7928 // MTASK:STATE-LS@
7929 // ( idx stid -- value )
7930 UFWORD(MT_LSTACK_LOAD) {
7931   UFO_MTASK_POP_STATE();
7932   const uint32_t idx = ufoPop();
7933   if (idx >= st->LP) ufoFatal("invalid lstack index %u (%u)", idx, st->LP);
7934   ufoPush(st->lStack[st->LP - idx - 1u]);
7935 }
7936
7937 // MTASK:STATE-DS!
7938 // ( value idx stid -- )
7939 UFWORD(MT_DSTACK_STORE) {
7940   UFO_MTASK_POP_STATE();
7941   const uint32_t idx = ufoPop();
7942   const uint32_t value = ufoPop();
7943   if (idx >= st->SP) ufoFatal("invalid stack index %u (%u)", idx, st->SP);
7944   st->dStack[st->SP - idx - 1u] = value;
7945 }
7946
7947 // MTASK:STATE-RS!
7948 // ( value idx stid -- )
7949 UFWORD(MT_RSTACK_STORE) {
7950   UFO_MTASK_POP_STATE();
7951   const uint32_t idx = ufoPop();
7952   const uint32_t value = ufoPop();
7953   if (idx >= st->RP) ufoFatal("invalid stack index %u (%u)", idx, st->RP);
7954   st->dStack[st->RP - idx - 1u] = value;
7955 }
7956
7957 // MTASK:STATE-LS!
7958 // ( value idx stid -- )
7959 UFWORD(MT_LSTACK_STORE) {
7960   UFO_MTASK_POP_STATE();
7961   const uint32_t idx = ufoPop();
7962   const uint32_t value = ufoPop();
7963   if (idx >= st->LP) ufoFatal("invalid stack index %u (%u)", idx, st->LP);
7964   st->dStack[st->LP - idx - 1u] = value;
7965 }
7966
7967 // MTASK:STATE-VSP@
7968 // ( stid -- vsp )
7969 UFWORD(MT_VSP_GET) {
7970   UFO_MTASK_POP_STATE();
7971   ufoPush(st->VSP);
7972 }
7973
7974 // MTASK:STATE-VSP!
7975 // ( vsp stid -- )
7976 UFWORD(MT_VSP_SET) {
7977   UFO_MTASK_POP_STATE();
7978   const uint32_t vsp = ufoPop();
7979   if (vsp > UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
7980   st->VSP = vsp;
7981 }
7982
7983 // MTASK:STATE-VSP-AT@
7984 // ( idx stidf -- value )
7985 UFWORD(MT_VSP_LOAD) {
7986   UFO_MTASK_POP_STATE();
7987   const uint32_t vsp = ufoPop();
7988   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
7989   ufoPush(st->vocStack[vsp]);
7990 }
7991
7992 // MTASK:STATE-VSP-AT!
7993 // ( value idx stid -- )
7994 UFWORD(MT_VSP_STORE) {
7995   UFO_MTASK_POP_STATE();
7996   const uint32_t vsp = ufoPop();
7997   const uint32_t value = ufoPop();
7998   if (vsp > UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
7999   st->vocStack[vsp] = value;
8000 }
8001
8002
8003 #include "urforth_tty.c"
8004
8005
8006 // ////////////////////////////////////////////////////////////////////////// //
8007 // "FILES" words
8008 //
8009
8010 static unsigned char ufoFileIOBuffer[4096];
8011
8012
8013 //==========================================================================
8014 //
8015 //  ufoPopFileName
8016 //
8017 //==========================================================================
8018 static char *ufoPopFileName (void) {
8019   uint32_t count = ufoPop();
8020   uint32_t addr = ufoPop();
8021
8022   if ((count & 0x80000000U) != 0) ufoFatal("invalid file name");
8023   if (count == 0) ufoFatal("empty file name");
8024   if (count > (uint32_t)sizeof(ufoFNameBuf) - 1u) ufoFatal("file name too long");
8025
8026   unsigned char *dest = (unsigned char *)ufoFNameBuf;
8027   while (count != 0) {
8028     *dest = ufoImgGetU8(addr);
8029     dest += 1u; addr += 1u; count -= 1u;
8030   }
8031   *dest = 0;
8032
8033   return ufoFNameBuf;
8034 }
8035
8036 // FILES:ERRNO
8037 // ( -- errno )
8038 UFWORD(FILES_ERRNO) {
8039   ufoPush((uint32_t)errno);
8040 }
8041
8042 // FILES:UNLINK
8043 // ( addr count -- success? )
8044 UFWORD(FILES_UNLINK) {
8045   const char *fname = ufoPopFileName();
8046   ufoPushBool(unlink(fname) == 0);
8047 }
8048
8049 // FILES:OPEN-R/O
8050 // ( addr count -- handle TRUE / FALSE )
8051 UFWORD(FILES_OPEN_RO) {
8052   const char *fname = ufoPopFileName();
8053   const int fd = open(fname, O_RDONLY);
8054   if (fd >= 0) {
8055     ufoPush((uint32_t)fd);
8056     ufoPushBool(1);
8057   } else {
8058     ufoPushBool(0);
8059   }
8060 }
8061
8062 // FILES:OPEN-R/W
8063 // ( addr count -- handle TRUE / FALSE )
8064 UFWORD(FILES_OPEN_RW) {
8065   const char *fname = ufoPopFileName();
8066   const int fd = open(fname, O_RDWR);
8067   if (fd >= 0) {
8068     ufoPush((uint32_t)fd);
8069     ufoPushBool(1);
8070   } else {
8071     ufoPushBool(0);
8072   }
8073 }
8074
8075 // FILES:CREATE
8076 // ( addr count -- handle TRUE / FALSE )
8077 UFWORD(FILES_CREATE) {
8078   const char *fname = ufoPopFileName();
8079   //FIXME: add variable with default flags
8080   const int fd = open(fname, O_RDWR|O_CREAT|O_TRUNC, 0644);
8081   if (fd >= 0) {
8082     ufoPush((uint32_t)fd);
8083     ufoPushBool(1);
8084   } else {
8085     ufoPushBool(0);
8086   }
8087 }
8088
8089 // FILES:CLOSE
8090 // ( handle -- success? )
8091 UFWORD(FILES_CLOSE) {
8092   const int32_t fd = (int32_t)ufoPop();
8093   if (fd < 0) ufoFatal("invalid file handle in 'CLOSE'");
8094   ufoPushBool(close(fd) == 0);
8095 }
8096
8097 // FILES:TELL
8098 // ( handle -- ofs TRUE / FALSE )
8099 // `handle` cannot be 0.
8100 UFWORD(FILES_TELL) {
8101   const int32_t fd = (int32_t)ufoPop();
8102   if (fd < 0) ufoFatal("invalid file handle in 'TELL'");
8103   const off_t pos = lseek(fd, 0, SEEK_CUR);
8104   if (pos != (off_t)-1) {
8105     ufoPush((uint32_t)pos);
8106     ufoPushBool(1);
8107   } else {
8108     ufoPushBool(0);
8109   }
8110 }
8111
8112 // FILES:SEEK-EX
8113 // ( ofs whence handle -- TRUE / FALSE )
8114 // `handle` cannot be 0.
8115 UFWORD(FILES_SEEK_EX) {
8116   const int32_t fd = (int32_t)ufoPop();
8117   const uint32_t whence = ufoPop();
8118   const uint32_t ofs = ufoPop();
8119   if (fd < 0) ufoFatal("invalid file handle in 'SEEK-EX'");
8120   if (whence != (uint32_t)SEEK_SET &&
8121       whence != (uint32_t)SEEK_CUR &&
8122       whence != (uint32_t)SEEK_END) ufoFatal("invalid `whence` in 'SEEK-EX'");
8123   const off_t pos = lseek(fd, (off_t)ofs, (int)whence);
8124   ufoPushBool(pos != (off_t)-1);
8125 }
8126
8127 // FILES:SIZE
8128 // ( handle -- size TRUE / FALSE )
8129 // `handle` cannot be 0.
8130 UFWORD(FILES_SIZE) {
8131   const int32_t fd = (int32_t)ufoPop();
8132   if (fd < 0) ufoFatal("invalid file handle in 'SIZE'");
8133   const off_t origpos = lseek(fd, 0, SEEK_CUR);
8134   if (origpos == (off_t)-1) {
8135     ufoPushBool(0);
8136   } else {
8137     const off_t size = lseek(fd, 0, SEEK_END);
8138     if (size == (off_t)-1) {
8139       (void)lseek(origpos, 0, SEEK_SET);
8140       ufoPushBool(0);
8141     } else if (lseek(origpos, 0, SEEK_SET) == origpos) {
8142       ufoPush((uint32_t)size);
8143       ufoPushBool(1);
8144     } else {
8145       ufoPushBool(0);
8146     }
8147   }
8148 }
8149
8150 // FILES:READ
8151 // ( addr count handle -- rdsize TRUE / FALSE )
8152 // `handle` cannot be 0.
8153 UFWORD(FILES_READ) {
8154   const int32_t fd = (int32_t)ufoPop();
8155   if (fd < 0) ufoFatal("invalid file handle in 'READ'");
8156   uint32_t count = ufoPop();
8157   uint32_t addr = ufoPop();
8158   uint32_t done = 0;
8159   if (count != 0) {
8160     if ((count & 0x80000000U) != 0) ufoFatal("invalid number of bytes to read from file");
8161     while (count != done) {
8162       uint32_t rd = (uint32_t)sizeof(ufoFileIOBuffer);
8163       if (rd > count) rd = count;
8164       for (;;) {
8165         const ssize_t xres = read(fd, ufoFileIOBuffer, rd);
8166         if (xres >= 0) { rd = (uint32_t)xres; break; }
8167         if (errno == EINTR) continue;
8168         if (errno == EAGAIN || errno == EWOULDBLOCK) { rd = 0; break; }
8169         // error
8170         ufoPushBool(0);
8171         return;
8172       }
8173       if (rd == 0) break;
8174       done += rd;
8175       for (uint32_t f = 0; f != rd; f += 1u) {
8176         ufoImgPutU8(addr, ufoFileIOBuffer[f]);
8177         addr += 1u;
8178       }
8179     }
8180   }
8181   ufoPush(done);
8182   ufoPushBool(1);
8183 }
8184
8185 // FILES:READ-EXACT
8186 // ( addr count handle -- TRUE / FALSE )
8187 // `handle` cannot be 0.
8188 UFWORD(FILES_READ_EXACT) {
8189   const int32_t fd = (int32_t)ufoPop();
8190   if (fd < 0) ufoFatal("invalid file handle in 'READ-EXACT'");
8191   uint32_t count = ufoPop();
8192   uint32_t addr = ufoPop();
8193   if (count != 0) {
8194     if ((count & 0x80000000U) != 0) ufoFatal("invalid number of bytes to read from file");
8195     while (count != 0) {
8196       uint32_t rd = (uint32_t)sizeof(ufoFileIOBuffer);
8197       if (rd > count) rd = count;
8198       for (;;) {
8199         const ssize_t xres = read(fd, ufoFileIOBuffer, rd);
8200         if (xres >= 0) { rd = (uint32_t)xres; break; }
8201         if (errno == EINTR) continue;
8202         if (errno == EAGAIN || errno == EWOULDBLOCK) { rd = 0; break; }
8203         // error
8204         ufoPushBool(0);
8205         return;
8206       }
8207       if (rd == 0) { ufoPushBool(0); return; } // still error
8208       count -= rd;
8209       for (uint32_t f = 0; f != rd; f += 1u) {
8210         ufoImgPutU8(addr, ufoFileIOBuffer[f]);
8211         addr += 1u;
8212       }
8213     }
8214   }
8215   ufoPushBool(1);
8216 }
8217
8218 // FILES:WRITE
8219 // ( addr count handle -- TRUE / FALSE )
8220 // `handle` cannot be 0.
8221 UFWORD(FILES_WRITE) {
8222   const int32_t fd = (int32_t)ufoPop();
8223   if (fd < 0) ufoFatal("invalid file handle in 'WRITE'");
8224   uint32_t count = ufoPop();
8225   uint32_t addr = ufoPop();
8226   if (count != 0) {
8227     if ((count & 0x80000000U) != 0) ufoFatal("invalid number of bytes to write to file");
8228     while (count != 0) {
8229       uint32_t wr = (uint32_t)sizeof(ufoFileIOBuffer);
8230       if (wr > count) wr = count;
8231       for (uint32_t f = 0; f != wr; f += 1u) {
8232         ufoFileIOBuffer[f] = ufoImgGetU8(addr + f);
8233       }
8234       for (;;) {
8235         const ssize_t xres = write(fd, ufoFileIOBuffer, wr);
8236         if (xres >= 0) { wr = (uint32_t)xres; break; }
8237         if (errno == EINTR) continue;
8238         fprintf(stderr, "ERRNO: %d (fd=%d)\n", errno, fd);
8239         //if (errno == EAGAIN || errno == EWOULDBLOCK) { wr = 0; break; }
8240         // error
8241         ufoPushBool(0);
8242         return;
8243       }
8244       if (wr == 0) { ufoPushBool(1); return; } // still error
8245       count -= wr; addr += wr;
8246     }
8247   }
8248   ufoPushBool(1);
8249 }
8250
8251
8252 // ////////////////////////////////////////////////////////////////////////// //
8253 // states
8254 //
8255
8256 #ifdef UFO_MTASK_ALLOWED
8257 //==========================================================================
8258 //
8259 //  ufoNewState
8260 //
8261 //  create a new state, its execution will start from the given CFA.
8262 //  state is not automatically activated.
8263 //
8264 //==========================================================================
8265 static UfoState *ufoNewState (void) {
8266   // find free state id
8267   uint32_t fidx = 0;
8268   uint32_t bmp = ufoStateUsedBitmap[0];
8269   while (fidx != (uint32_t)(UFO_MAX_STATES/32) && bmp == ~(uint32_t)0) {
8270     fidx += 1u;
8271     bmp = ufoStateUsedBitmap[fidx];
8272   }
8273   if (fidx == (uint32_t)(UFO_MAX_STATES/32)) ufoFatal("too many execution states");
8274   //fprintf(stderr, "NST:000: fidx=%u; bmp=0x%08x\n", fidx, bmp);
8275   fidx *= 32u;
8276   while ((bmp & 0x01) != 0) { fidx += 1u; bmp >>= 1; }
8277   ufo_assert(fidx < UFO_MAX_STATES);
8278   ufo_assert((ufoStateUsedBitmap[fidx / 32u] & ((uint32_t)1 << (fidx & 0x1f))) == 0);
8279   ufo_assert(ufoStateMap[fidx] == NULL);
8280   UfoState *st = calloc(1, sizeof(UfoState));
8281   if (st == NULL) ufoFatal("out of memory for states");
8282   st->id = fidx + 1u;
8283   ufoStateMap[fidx] = st;
8284   ufoStateUsedBitmap[fidx / 32u] |= ((uint32_t)1 << (fidx & 0x1f));
8285   //fprintf(stderr, "NST: fidx=%u; 0x%08x\n", fidx, ufoStateUsedBitmap[fidx / 32u]);
8286   return st;
8287 }
8288
8289
8290 //==========================================================================
8291 //
8292 //  ufoFreeState
8293 //
8294 //  free all memory used for the state, remove it from state list.
8295 //  WARNING! never free current state!
8296 //
8297 //==========================================================================
8298 static void ufoFreeState (UfoState *st) {
8299   if (st != NULL) {
8300     if (st == ufoCurrState) ufoFatal("cannot free active state");
8301     if (ufoYieldedState == st) ufoYieldedState = NULL;
8302     if (ufoDebuggerState == st) ufoDebuggerState = NULL;
8303     const uint32_t fidx = st->id - 1u;
8304     //fprintf(stderr, "FST: fidx=%u; 0x%08x\n", fidx, ufoStateUsedBitmap[fidx / 32u]);
8305     ufo_assert(fidx < UFO_MAX_STATES);
8306     ufo_assert((ufoStateUsedBitmap[fidx / 32u] & (1u << (fidx & 0x1f))) != 0);
8307     ufo_assert(ufoStateMap[fidx] == st);
8308     // free default TIB handle
8309     UfoState *oldst = ufoCurrState;
8310     ufoCurrState = st;
8311     const uint32_t tib = ufoImgGetU32(ufoAddrDefTIB);
8312     if ((tib & UFO_ADDR_TEMP_BIT) != 0) {
8313       UfoHandle *tibh = ufoGetHandle(tib);
8314       if (tibh != NULL) ufoFreeHandle(tibh);
8315     }
8316     ufoCurrState = oldst;
8317     // free temp buffer
8318     #ifndef UFO_HUGE_IMAGES
8319     if (st->imageTemp != NULL) free(st->imageTemp);
8320     #endif
8321     free(st);
8322     ufoStateMap[fidx] = NULL;
8323     ufoStateUsedBitmap[fidx / 32u] &= ~((uint32_t)1 << (fidx & 0x1f));
8324   }
8325 }
8326
8327
8328 //==========================================================================
8329 //
8330 //  ufoFindState
8331 //
8332 //==========================================================================
8333 static UfoState *ufoFindState (uint32_t stid) {
8334   UfoState *res = NULL;
8335   if (stid >= 0 && stid <= UFO_MAX_STATES) {
8336     if (stid == 0) {
8337       // current
8338       ufo_assert(ufoCurrState != NULL);
8339       stid = ufoCurrState->id - 1u;
8340     } else {
8341       stid -= 1u;
8342     }
8343     res = ufoStateMap[stid];
8344     if (res != NULL) {
8345       ufo_assert((ufoStateUsedBitmap[stid / 32u] & (1u << (stid & 0x1f))) != 0);
8346       ufo_assert(res->id == stid + 1u);
8347     } else {
8348       ufo_assert((ufoStateUsedBitmap[stid / 32u] & (1u << (stid & 0x1f))) == 0);
8349     }
8350   }
8351   return res;
8352 }
8353
8354
8355 //==========================================================================
8356 //
8357 //  ufoSwitchToState
8358 //
8359 //==========================================================================
8360 static void ufoSwitchToState (UfoState *newst) {
8361   ufo_assert(newst != NULL);
8362   if (newst != ufoCurrState) {
8363     ufoCurrState = newst;
8364   }
8365 }
8366 #endif
8367
8368
8369 // ////////////////////////////////////////////////////////////////////////// //
8370 // initial dictionary definitions
8371 //
8372
8373 #undef UFWORD
8374
8375 #define UFWORD(name_)  do { \
8376   const uint32_t xcfa_ = ufoCFAsUsed; \
8377   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
8378   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
8379   ufoCFAsUsed += 1; \
8380   ufoDefineNative(""#name_, xcfa_, 0); \
8381 } while (0)
8382
8383 #define UFWORDX(strname_,name_)  do { \
8384   const uint32_t xcfa_ = ufoCFAsUsed; \
8385   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
8386   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
8387   ufoCFAsUsed += 1; \
8388   ufoDefineNative(strname_, xcfa_, 0); \
8389 } while (0)
8390
8391 #define UFWORD_IMM(name_)  do { \
8392   const uint32_t xcfa_ = ufoCFAsUsed; \
8393   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
8394   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
8395   ufoCFAsUsed += 1; \
8396   ufoDefineNative(""#name_, xcfa_, UFW_FLAG_IMMEDIATE); \
8397 } while (0)
8398
8399 #define UFWORDX_IMM(strname_,name_)  do { \
8400   const uint32_t xcfa_ = ufoCFAsUsed; \
8401   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
8402   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
8403   ufoCFAsUsed += 1; \
8404   ufoDefineNative(strname_, xcfa_, UFW_FLAG_IMMEDIATE); \
8405 } while (0)
8406
8407 #define UFC(name_)  ufoImgEmitU32_NoInline(ufoFindWordChecked(name_))
8408
8409
8410 //==========================================================================
8411 //
8412 //  ufoFindWordChecked
8413 //
8414 //==========================================================================
8415 UFO_DISABLE_INLINE uint32_t ufoFindWordChecked (const char *wname) {
8416   const uint32_t cfa = ufoFindWord(wname);
8417   if (cfa == 0) ufoFatal("word '%s' not found", wname);
8418   return cfa;
8419 }
8420
8421
8422 //==========================================================================
8423 //
8424 //  ufoGetForthVocId
8425 //
8426 //  get "FORTH" vocid
8427 //
8428 //==========================================================================
8429 uint32_t ufoGetForthVocId (void) {
8430   return ufoForthVocId;
8431 }
8432
8433
8434 //==========================================================================
8435 //
8436 //  ufoVocSetOnlyDefs
8437 //
8438 //==========================================================================
8439 void ufoVocSetOnlyDefs (uint32_t vocid) {
8440   ufoImgPutU32(ufoAddrCurrent, vocid);
8441   ufoImgPutU32(ufoAddrContext, vocid);
8442 }
8443
8444
8445 //==========================================================================
8446 //
8447 //  ufoCreateVoc
8448 //
8449 //  return voc PFA (vocid)
8450 //
8451 //==========================================================================
8452 uint32_t ufoCreateVoc (const char *wname, uint32_t parentvocid, uint32_t flags) {
8453   // create wordlist struct
8454   // typeid, used by Forth code (structs and such)
8455   ufoImgEmitU32(0); // typeid
8456   // vocid points here, to "LATEST-LFA"
8457   const uint32_t vocid = UFO_GET_DP();
8458   //fprintf(stderr, "NEW VOCID (%s): 0x%08x\n", wname, vocid);
8459   ufoImgEmitU32(0); // latest
8460   const uint32_t vlink = UFO_GET_DP();
8461   if ((vocid & UFO_ADDR_TEMP_BIT) == 0) {
8462     ufoImgEmitU32(ufoImgGetU32(ufoAddrVocLink)); // voclink
8463     ufoImgPutU32(ufoAddrVocLink, vlink); // update voclink
8464   } else {
8465     abort();
8466     ufoImgEmitU32(0);
8467   }
8468   ufoImgEmitU32(parentvocid); // parent
8469   const uint32_t hdraddr = UFO_GET_DP();
8470   ufoImgEmitU32(0); // word header
8471   // create empty hash table
8472   for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) ufoImgEmitU32(0);
8473   // update CONTEXT and CURRENT if this is the first wordlist ever
8474   if (ufoImgGetU32(ufoAddrContext) == 0) {
8475     ufoImgPutU32(ufoAddrContext, vocid);
8476   }
8477   if (ufoImgGetU32(ufoAddrCurrent) == 0) {
8478     ufoImgPutU32(ufoAddrCurrent, vocid);
8479   }
8480   // create word header
8481   if (wname != NULL && wname[0] != 0) {
8482     /*
8483     uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
8484     flags &=
8485       //UFW_FLAG_IMMEDIATE|
8486       //UFW_FLAG_SMUDGE|
8487       //UFW_FLAG_NORETURN|
8488       UFW_FLAG_HIDDEN|
8489       //UFW_FLAG_CBLOCK|
8490       //UFW_FLAG_VOCAB|
8491       //UFW_FLAG_SCOLON|
8492       UFW_FLAG_PROTECTED;
8493     flags |= UFW_FLAG_VOCAB;
8494     */
8495     flags &= 0xffffff00u;
8496     flags |= UFW_FLAG_VOCAB;
8497     ufoCreateWordHeader(wname, flags);
8498     const uint32_t cfa = UFO_GET_DP();
8499     ufoImgEmitCFA(ufoDoVocCFA); // cfa
8500     ufoImgEmitU32(vocid); // pfa
8501     // update vocab header pointer
8502     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
8503     ufoImgPutU32(hdraddr, UFO_LFA_TO_NFA(lfa));
8504     #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
8505     ufoDumpWordHeader(lfa);
8506     #endif
8507   }
8508   return vocid;
8509 }
8510
8511
8512 //==========================================================================
8513 //
8514 //  ufoSetLatestArgs
8515 //
8516 //==========================================================================
8517 static void ufoSetLatestArgs (uint32_t warg) {
8518   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
8519   const uint32_t lfa = ufoImgGetU32(curr);
8520   const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
8521   uint32_t flags = ufoImgGetU32(nfa);
8522   //fprintf(stderr, "OLD FLAGS: 0x%08x\n", flags);
8523   flags &= ~UFW_WARG_MASK;
8524   flags |= warg & UFW_WARG_MASK;
8525   //fprintf(stderr, "NEW FLAGS: 0x%08x\n", flags);
8526   ufoImgPutU32(nfa, flags);
8527   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
8528   ufoDumpWordHeader(lfa);
8529   #endif
8530 }
8531
8532
8533 //==========================================================================
8534 //
8535 //  ufoSetLatestFlags
8536 //
8537 //==========================================================================
8538 static void ufoSetLatestFlags (uint32_t orflags) {
8539   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
8540   const uint32_t lfa = ufoImgGetU32(curr);
8541   const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
8542   uint32_t flags = ufoImgGetU32(nfa);
8543   flags |= orflags;
8544   ufoImgPutU32(nfa, flags);
8545   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
8546   ufoDumpWordHeader(lfa);
8547   #endif
8548 }
8549
8550
8551 //==========================================================================
8552 //
8553 //  ufoDefine
8554 //
8555 //==========================================================================
8556 static void ufoDefineNative (const char *wname, uint32_t cfaidx, uint32_t orflags) {
8557   cfaidx |= UFO_ADDR_CFA_BIT;
8558   uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
8559   flags &=
8560       //UFW_FLAG_IMMEDIATE|
8561       //UFW_FLAG_SMUDGE|
8562       //UFW_FLAG_NORETURN|
8563       UFW_FLAG_HIDDEN|
8564       //UFW_FLAG_CBLOCK|
8565       //UFW_FLAG_VOCAB|
8566       //UFW_FLAG_SCOLON|
8567       UFW_FLAG_PROTECTED;
8568   //if (immed) flags |= UFW_FLAG_IMMEDIATE;
8569   flags |= orflags;
8570   ufoCreateWordHeader(wname, flags);
8571   ufoImgEmitCFA(cfaidx);
8572 }
8573
8574
8575 //==========================================================================
8576 //
8577 //  ufoDefineConstant
8578 //
8579 //==========================================================================
8580 static void ufoDefineConstant (const char *name, uint32_t value) {
8581   ufoDefineNative(name, ufoDoConstCFA, 0);
8582   ufoImgEmitU32(value);
8583 }
8584
8585
8586 //==========================================================================
8587 //
8588 //  ufoDefineUserVar
8589 //
8590 //==========================================================================
8591 static void ufoDefineUserVar (const char *name, uint32_t addr) {
8592   ufoDefineNative(name, ufoDoUserVariableCFA, 0);
8593   ufoImgEmitU32(addr);
8594 }
8595
8596
8597 //==========================================================================
8598 //
8599 //  ufoDefineVar
8600 //
8601 //==========================================================================
8602 static void ufoDefineVar (const char *name, uint32_t value) {
8603   ufoDefineNative(name, ufoDoVariableCFA, 0);
8604   ufoImgEmitU32(value);
8605 }
8606
8607
8608 //==========================================================================
8609 //
8610 //  ufoDefineDefer
8611 //
8612 //==========================================================================
8613 static void ufoDefineDefer (const char *name, uint32_t value) {
8614   ufoDefineNative(name, ufoDoDeferCFA, 0);
8615   ufoImgEmitU32(value);
8616 }
8617
8618
8619 //==========================================================================
8620 //
8621 //  ufoHiddenWords
8622 //
8623 //==========================================================================
8624 static void ufoHiddenWords (void) {
8625   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
8626   ufoImgPutU32(ufoAddrNewWordFlags, flags | UFW_FLAG_HIDDEN);
8627 }
8628
8629
8630 //==========================================================================
8631 //
8632 //  ufoPublicWords
8633 //
8634 //==========================================================================
8635 static void ufoPublicWords (void) {
8636   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
8637   ufoImgPutU32(ufoAddrNewWordFlags, flags & ~UFW_FLAG_HIDDEN);
8638 }
8639
8640
8641 //==========================================================================
8642 //
8643 //  ufoDefineForth
8644 //
8645 //==========================================================================
8646 /*
8647 static void ufoDefineForth (const char *name) {
8648   ufoDefineNative(name, ufoDoForthCFA, 0);
8649 }
8650 */
8651
8652
8653 //==========================================================================
8654 //
8655 //  ufoDefineForthImm
8656 //
8657 //==========================================================================
8658 /*
8659 static void ufoDefineForthImm (const char *name) {
8660   ufoDefineNative(name, ufoDoForthCFA, 1);
8661 }
8662 */
8663
8664
8665 //==========================================================================
8666 //
8667 //  ufoDefineForthHidden
8668 //
8669 //==========================================================================
8670 /*
8671 static void ufoDefineForthHidden (const char *name) {
8672   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
8673   ufoImgPutU32(ufoAddrNewWordFlags, flags | UFW_FLAG_HIDDEN);
8674   ufoDefineNative(name, ufoDoForthCFA, 0);
8675   ufoImgPutU32(ufoAddrNewWordFlags, flags);
8676 }
8677 */
8678
8679
8680 //==========================================================================
8681 //
8682 //  ufoDefineSColonForth
8683 //
8684 //  create word suitable for scattered colon extension
8685 //
8686 //==========================================================================
8687 static void ufoDefineSColonForth (const char *name) {
8688   ufoDefineNative(name, ufoDoForthCFA, UFW_FLAG_SCOLON);
8689   // placeholder for scattered colon
8690   // it will compile two branches:
8691   // the first branch will jump to the first "..:" word (or over the two branches)
8692   // the second branch is never taken, and works as a pointer to the latest branch addr in the list
8693   // this way, each extension word will simply fix the last branch address, and update list tail
8694   // at the creation time, second branch points to the first branch
8695   UFC("FORTH:(BRANCH)");
8696   const uint32_t xjmp = UFO_GET_DP();
8697   ufoImgEmitU32(0);
8698   UFC("FORTH:(BRANCH)");
8699   #ifdef UFO_RELATIVE_BRANCH
8700   ufoImgEmitU32(xjmp - UFO_GET_DP()); // address of the fist branch dest
8701   ufoImgPutU32(xjmp, UFO_GET_DP() - xjmp); // jump over the jump
8702   #else
8703   ufoImgEmitU32(xjmp);
8704   ufoImgPutU32(xjmp, UFO_GET_DP());
8705   #endif
8706 }
8707
8708
8709 //==========================================================================
8710 //
8711 //  ufoDoneForth
8712 //
8713 //==========================================================================
8714 UFO_FORCE_INLINE void ufoDoneForth (void) {
8715   UFC("FORTH:(EXIT)");
8716 }
8717
8718
8719 //==========================================================================
8720 //
8721 //  ufoCompileStrLit
8722 //
8723 //  compile string literal, the same as QUOTE_IMM
8724 //
8725 //==========================================================================
8726 static void ufoCompileStrLitEx (const char *str, const uint32_t slen) {
8727   if (str == NULL) str = "";
8728   if (slen > 255) ufoFatal("string literal too long");
8729   UFC("FORTH:(LITSTR8)");
8730   ufoImgEmitU8((uint8_t)slen);
8731   for (size_t f = 0; f < slen; f += 1) {
8732     ufoImgEmitU8(((const unsigned char *)str)[f]);
8733   }
8734   ufoImgEmitU8(0);
8735   ufoImgEmitAlign();
8736 }
8737
8738
8739 //==========================================================================
8740 //
8741 //  ufoCompileStrLit
8742 //
8743 //==========================================================================
8744 /*
8745 static void ufoCompileStrLit (const char *str) {
8746   ufoCompileStrLitEx(str, (uint32_t)strlen(str));
8747 }
8748 */
8749
8750
8751 //==========================================================================
8752 //
8753 //  ufoCompileLit
8754 //
8755 //==========================================================================
8756 static void ufoCompileLit (uint32_t value) {
8757   UFC("FORTH:(LIT)");
8758   ufoImgEmitU32(value);
8759 }
8760
8761
8762 //==========================================================================
8763 //
8764 //  ufoCompileCFALit
8765 //
8766 //==========================================================================
8767 /*
8768 static void ufoCompileCFALit (const char *wname) {
8769   UFC("FORTH:(LITCFA)");
8770   const uint32_t cfa = ufoFindWordChecked(wname);
8771   ufoImgEmitU32(cfa);
8772 }
8773 */
8774
8775
8776 //==========================================================================
8777 //
8778 //  ufoXStrEquCI
8779 //
8780 //==========================================================================
8781 static int ufoXStrEquCI (const char *word, const char *text, uint32_t tlen) {
8782   while (tlen != 0 && *word) {
8783     if (toUpper(*word) != toUpper(*text)) return 0;
8784     word += 1u; text += 1u; tlen -= 1u;
8785   }
8786   return (tlen == 0 && *word == 0);
8787 }
8788
8789
8790 #define UFO_MAX_LABEL_NAME  (63)
8791 typedef struct UfoLabel_t {
8792   uint32_t hash;
8793   uint32_t namelen;
8794   char name[UFO_MAX_LABEL_NAME];
8795   uint32_t addr; // jump chain tail, or address
8796   uint32_t defined;
8797   uint32_t word; // is this a forward word definition?
8798   struct UfoLabel_t *next;
8799 } UfoLabel;
8800
8801 static UfoLabel *ufoLabels = NULL;
8802
8803
8804 //==========================================================================
8805 //
8806 //  ufoFindAddLabelEx
8807 //
8808 //==========================================================================
8809 static UfoLabel *ufoFindAddLabelEx (const char *name, uint32_t namelen, int allowAdd) {
8810   if (namelen == 0 || namelen > UFO_MAX_LABEL_NAME) ufoFatal("invalid label name");
8811   const uint32_t hash = joaatHashBufCI(name, namelen);
8812   UfoLabel *lbl = ufoLabels;
8813   while (lbl != NULL) {
8814     if (lbl->hash == hash && lbl->namelen == namelen) {
8815       int ok = 1;
8816       uint32_t sidx = 0;
8817       while (ok && sidx != namelen) {
8818         ok = (toUpper(name[sidx]) == toUpper(lbl->name[sidx]));
8819         sidx += 1;
8820       }
8821       if (ok) return lbl;
8822     }
8823     lbl = lbl->next;
8824   }
8825   if (allowAdd) {
8826     // create new label
8827     lbl = calloc(1, sizeof(UfoLabel));
8828     lbl->hash = hash;
8829     lbl->namelen = namelen;
8830     memcpy(lbl->name, name, namelen);
8831     lbl->name[namelen] = 0;
8832     lbl->next = ufoLabels;
8833     ufoLabels = lbl;
8834     return lbl;
8835   } else {
8836     return NULL;
8837   }
8838 }
8839
8840
8841 //==========================================================================
8842 //
8843 //  ufoFindAddLabel
8844 //
8845 //==========================================================================
8846 static UfoLabel *ufoFindAddLabel (const char *name, uint32_t namelen) {
8847   return ufoFindAddLabelEx(name, namelen, 1);
8848 }
8849
8850
8851 //==========================================================================
8852 //
8853 //  ufoFindLabel
8854 //
8855 //==========================================================================
8856 static UfoLabel *ufoFindLabel (const char *name, uint32_t namelen) {
8857   return ufoFindAddLabelEx(name, namelen, 0);
8858 }
8859
8860
8861 //==========================================================================
8862 //
8863 //  ufoTrySimpleNumber
8864 //
8865 //  only decimal and C-like hexes; with an optional sign
8866 //
8867 //==========================================================================
8868 static int ufoTrySimpleNumber (const char *text, uint32_t tlen, uint32_t *num) {
8869   int neg = 0;
8870
8871   if (tlen != 0 && *text == '+') { text += 1u; tlen -= 1u; }
8872   else if (tlen != 0 && *text == '-') { neg = 1; text += 1u; tlen -= 1u; }
8873
8874   int base = 10; // default base
8875   if (tlen > 2 && text[0] == '0' && toUpper(text[1]) == 'X') {
8876     // hex
8877     base = 16;
8878     text += 2u; tlen -= 2u;
8879   }
8880
8881   if (tlen == 0 || digitInBase(*text, base) < 0) return 0;
8882
8883   int wasDigit = 0;
8884   uint32_t n = 0;
8885   int dig;
8886   while (tlen != 0) {
8887     if (*text == '_') {
8888       if (!wasDigit) return 0;
8889       wasDigit = 0;
8890     } else {
8891       dig = digitInBase(*text, base);
8892       if (dig < 0) return 0;
8893       wasDigit = 1;
8894       n = n * (uint32_t)base + (uint32_t)dig;
8895     }
8896     text += 1u; tlen -= 1u;
8897   }
8898
8899   if (!wasDigit) return 0;
8900   if (neg) n = ~n + 1u;
8901   *num = n;
8902   return 1;
8903 }
8904
8905
8906 //==========================================================================
8907 //
8908 //  ufoEmitLabelChain
8909 //
8910 //==========================================================================
8911 static void ufoEmitLabelChain (UfoLabel *lbl) {
8912   ufo_assert(lbl != NULL);
8913   ufo_assert(lbl->defined == 0);
8914   const uint32_t here = UFO_GET_DP();
8915   ufoImgEmitU32(lbl->addr);
8916   lbl->addr = here;
8917 }
8918
8919
8920 #ifdef UFO_RELATIVE_BRANCH
8921 #define UFO_XCOMPILER_BRANCH_SET(addr_,dest_)  { \
8922   const uint32_t a = (addr_); \
8923   const uint32_t da = (dest_); \
8924   ufoImgPutU32(a, da - a); \
8925 } while (0)
8926 #else
8927 #define UFO_XCOMPILER_BRANCH_SET(addr_,dest_)  { \
8928   const uint32_t a = (addr_); \
8929   const uint32_t da = (dest_); \
8930   ufoImgPutU32(a, da); \
8931 } while (0)
8932 #endif
8933
8934
8935 //==========================================================================
8936 //
8937 //  ufoEmitLabelRefHere
8938 //
8939 //==========================================================================
8940 UFO_FORCE_INLINE void ufoEmitLabelRefHere (UfoLabel *lbl) {
8941   ufo_assert(lbl != NULL);
8942   ufo_assert(lbl->defined != 0);
8943   if (lbl->word) {
8944     ufoImgEmitU32(lbl->addr);
8945   } else {
8946     const uint32_t here = UFO_GET_DP();
8947     ufoImgEmitU32(0);
8948     UFO_XCOMPILER_BRANCH_SET(here, lbl->addr);
8949   }
8950 }
8951
8952
8953 //==========================================================================
8954 //
8955 //  ufoFixLabelChainHere
8956 //
8957 //==========================================================================
8958 static void ufoFixLabelChainHere (UfoLabel *lbl) {
8959   ufo_assert(lbl != NULL);
8960   ufo_assert(lbl->defined == 0);
8961   const uint32_t here = UFO_GET_DP();
8962   lbl->defined = 1;
8963   while (lbl->addr != 0) {
8964     const uint32_t aprev = ufoImgGetU32(lbl->addr);
8965     if (lbl->word) {
8966       ufoImgPutU32(lbl->addr, here);
8967     } else {
8968       UFO_XCOMPILER_BRANCH_SET(lbl->addr, here);
8969     }
8970     lbl->addr = aprev;
8971   }
8972   lbl->addr = here;
8973 }
8974
8975
8976 #define UFO_MII_WORD_X_COMPILE   (-5)
8977 #define UFO_MII_WORD_COMPILE_IMM (-4)
8978 #define UFO_MII_WORD_CFA_LIT     (-3)
8979 #define UFO_MII_WORD_COMPILE     (-2)
8980 #define UFO_MII_IN_WORD          (-1)
8981 #define UFO_MII_NO_WORD          (0)
8982 #define UFO_MII_WORD_NAME        (1)
8983 #define UFO_MII_WORD_NAME_IMM    (2)
8984 #define UFO_MII_WORD_NAME_HIDDEN (3)
8985
8986 static int ufoMinInterpState = UFO_MII_NO_WORD;
8987
8988
8989 //==========================================================================
8990 //
8991 //  ufoFinalLabelCheck
8992 //
8993 //==========================================================================
8994 static void ufoFinalLabelCheck (void) {
8995   int errorCount = 0;
8996   if (ufoMinInterpState != UFO_MII_NO_WORD) {
8997     ufoFatal("missing semicolon");
8998   }
8999   while (ufoLabels != NULL) {
9000     UfoLabel *lbl = ufoLabels; ufoLabels = lbl->next;
9001     if (!lbl->defined) {
9002       fprintf(stderr, "UFO ERROR: label '%s' is not defined!\n", lbl->name);
9003       errorCount += 1;
9004     }
9005     free(lbl);
9006   }
9007   if (errorCount != 0) {
9008     ufoFatal("%d undefined label%s", errorCount, (errorCount != 1 ? "s" : ""));
9009   }
9010 }
9011
9012
9013 //==========================================================================
9014 //
9015 //  ufoInterpretLine
9016 //
9017 //  this is so i could write Forth definitions more easily
9018 //
9019 //  labels:
9020 //    $name -- reference
9021 //    $name: -- definition
9022 //
9023 //==========================================================================
9024 UFO_DISABLE_INLINE void ufoInterpretLine (const char *line) {
9025   char wname[UFO_MAX_WORD_LENGTH];
9026   uint32_t wlen, num, cfa;
9027   UfoLabel *lbl;
9028   while (*line) {
9029     if (*(const unsigned char *)line <= 32) {
9030       line += 1;
9031     } else if (ufoMinInterpState == UFO_MII_WORD_CFA_LIT ||
9032                ufoMinInterpState == UFO_MII_WORD_COMPILE ||
9033                ufoMinInterpState == UFO_MII_WORD_COMPILE_IMM ||
9034                ufoMinInterpState == UFO_MII_WORD_X_COMPILE)
9035     {
9036       // "[']"/"COMPILE"/"[COMPILE]" argument
9037       wlen = 1;
9038       while (((const unsigned char *)line)[wlen] > 32) wlen += 1;
9039       if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
9040       memcpy(wname, line, wlen);
9041       wname[wlen] = 0;
9042       switch (ufoMinInterpState) {
9043         case UFO_MII_WORD_CFA_LIT: UFC("FORTH:(LITCFA)"); break;
9044         case UFO_MII_WORD_COMPILE: UFC("FORTH:(LITCFA)"); break;
9045         case UFO_MII_WORD_X_COMPILE: UFC("FORTH:(LITCFA)"); break;
9046         case UFO_MII_WORD_COMPILE_IMM: break;
9047         default: ufo_assert(0);
9048       }
9049       cfa = ufoFindWord(wname);
9050       if (cfa != 0) {
9051         ufoImgEmitU32(cfa);
9052       } else {
9053         // forward reference
9054         lbl = ufoFindAddLabel(line, wlen);
9055         if (lbl->defined || (lbl->word == 0 && lbl->addr)) {
9056           ufoFatal("unknown word: '%s'", wname);
9057         }
9058         lbl->word = 1;
9059         ufoEmitLabelChain(lbl);
9060       }
9061       switch (ufoMinInterpState) {
9062         case UFO_MII_WORD_CFA_LIT: break;
9063         case UFO_MII_WORD_COMPILE: UFC("FORTH:COMPILE,"); break;
9064         case UFO_MII_WORD_X_COMPILE: UFC("FORTH:,"); break;
9065         case UFO_MII_WORD_COMPILE_IMM: break;
9066         default: ufo_assert(0);
9067       }
9068       ufoMinInterpState = UFO_MII_IN_WORD;
9069       line += wlen;
9070     } else if (ufoMinInterpState > UFO_MII_NO_WORD) {
9071       // new word
9072       wlen = 1;
9073       while (((const unsigned char *)line)[wlen] > 32) wlen += 1;
9074       if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
9075       if (wlen > 2 && line[0] == ':' && line[wlen - 1u] == ':') ufoFatal("invalid word name");
9076       memcpy(wname, line, wlen);
9077       wname[wlen] = 0;
9078       const uint32_t oldFlags = ufoImgGetU32(ufoAddrNewWordFlags);
9079       if (ufoMinInterpState == UFO_MII_WORD_NAME_HIDDEN) {
9080         ufoImgPutU32(ufoAddrNewWordFlags, oldFlags | UFW_FLAG_HIDDEN);
9081       }
9082       ufoDefineNative(wname, ufoDoForthCFA,
9083                       (ufoMinInterpState == UFO_MII_WORD_NAME_IMM ? UFW_FLAG_IMMEDIATE : 0));
9084       ufoImgPutU32(ufoAddrNewWordFlags, oldFlags);
9085       ufoMinInterpState = UFO_MII_IN_WORD;
9086       // check for forward references
9087       lbl = ufoFindLabel(line, wlen);
9088       if (lbl != NULL) {
9089         if (lbl->defined || !lbl->word) {
9090           ufoFatal("label/word conflict for '%.*s'", (unsigned)wlen, line);
9091         }
9092         ufoFixLabelChainHere(lbl);
9093       }
9094       line += wlen;
9095     } else if ((line[0] == ';' && line[1] == ';') ||
9096                (line[0] == '-' && line[1] == '-') ||
9097                (line[0] == '/' && line[1] == '/') ||
9098                (line[0] == '\\' && ((const unsigned char *)line)[1] <= 32))
9099     {
9100       ufoFatal("do not use single-line comments");
9101     } else if (line[0] == '(' && ((const unsigned char *)line)[1] <= 32) {
9102       while (*line && *line != ')') line += 1;
9103       if (*line == ')') line += 1;
9104     } else {
9105       // word
9106       wlen = 1;
9107       while (((const unsigned char *)line)[wlen] > 32) wlen += 1;
9108       if (wlen == 1 && (line[0] == '"' || line[0] == '`')) {
9109         // string literal
9110         const char qch = line[0];
9111         if (!line[1]) ufoFatal("unterminated string literal");
9112         // skip quote and space
9113         if (((const unsigned char *)line)[1] <= 32) line += 2u; else line += 1u;
9114         wlen = 0;
9115         while (line[wlen] && line[wlen] != qch) wlen += 1u;
9116         if (line[wlen] != qch) ufoFatal("unterminated string literal");
9117         ufoCompileStrLitEx(line, wlen);
9118         line += wlen + 1u; // skip final quote
9119       } else if (wlen == 1 && line[0] == ':') {
9120         // new word
9121         if (ufoMinInterpState != UFO_MII_NO_WORD) ufoFatal("unexpected colon");
9122         ufoMinInterpState = UFO_MII_WORD_NAME;
9123         line += wlen;
9124       } else if (wlen == 1 && line[0] == ';') {
9125         // end word
9126         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected semicolon");
9127         ufoImgEmitU32(ufoFindWordChecked("FORTH:(EXIT)"));
9128         ufoMinInterpState = UFO_MII_NO_WORD;
9129         line += wlen;
9130       } else if (wlen == 2 && line[0] == '!' && line[1] == ':') {
9131         // new immediate word
9132         if (ufoMinInterpState != UFO_MII_NO_WORD) ufoFatal("unexpected colon");
9133         ufoMinInterpState = UFO_MII_WORD_NAME_IMM;
9134         line += wlen;
9135       } else if (wlen == 2 && line[0] == '*' && line[1] == ':') {
9136         // new hidden word
9137         if (ufoMinInterpState != UFO_MII_NO_WORD) ufoFatal("unexpected colon");
9138         ufoMinInterpState = UFO_MII_WORD_NAME_HIDDEN;
9139         line += wlen;
9140       } else if (wlen == 3 && memcmp(line, "[']", 3) == 0) {
9141         // cfa literal
9142         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
9143         ufoMinInterpState = UFO_MII_WORD_CFA_LIT;
9144         line += wlen;
9145       } else if (wlen == 7 && ufoXStrEquCI("COMPILE", line, wlen)) {
9146         // "COMPILE"
9147         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
9148         ufoMinInterpState = UFO_MII_WORD_COMPILE;
9149         line += wlen;
9150       } else if (wlen == 9 && ufoXStrEquCI("X-COMPILE", line, wlen)) {
9151         // "COMPILE"
9152         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
9153         ufoMinInterpState = UFO_MII_WORD_X_COMPILE;
9154         line += wlen;
9155       } else if (wlen == 9 && ufoXStrEquCI("[COMPILE]", line, wlen)) {
9156         // "[COMPILE]"
9157         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
9158         ufoMinInterpState = UFO_MII_WORD_COMPILE_IMM;
9159         line += wlen;
9160       } else {
9161         // look for a word
9162         if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
9163         memcpy(wname, line, wlen);
9164         wname[wlen] = 0;
9165         cfa = ufoFindWord(wname);
9166         if (cfa != 0) {
9167           // compile word
9168           ufoImgEmitU32(cfa);
9169         } else if (ufoTrySimpleNumber(line, wlen, &num)) {
9170           // compile numeric literal
9171           ufoCompileLit(num);
9172         } else {
9173           // unknown word, this may be a forward reference, or a label definition
9174           // label defintion starts with "$"
9175           // (there are no words starting with "$" in the initial image)
9176           if (line[0] == '$') {
9177             if (wlen == 1) ufoFatal("dollar what?");
9178             if (wlen > 2 && line[wlen - 1u] == ':') {
9179               // label definition
9180               lbl = ufoFindAddLabel(line, wlen - 1u);
9181               if (lbl->defined) ufoFatal("double label '%s' definition", lbl->name);
9182               if (lbl->word)  ufoFatal("double label '%s' word conflict", lbl->name);
9183               ufoFixLabelChainHere(lbl);
9184             } else {
9185               // label reference
9186               lbl = ufoFindAddLabel(line, wlen);
9187               if (lbl->defined) {
9188                 ufoEmitLabelRefHere(lbl);
9189               } else {
9190                 ufoEmitLabelChain(lbl);
9191               }
9192             }
9193           } else {
9194             // forward reference
9195             lbl = ufoFindAddLabel(line, wlen);
9196             if (lbl->defined || (lbl->word == 0 && lbl->addr)) {
9197               ufoFatal("unknown word: '%s'", wname);
9198             }
9199             lbl->word = 1;
9200             ufoEmitLabelChain(lbl);
9201           }
9202         }
9203         line += wlen;
9204       }
9205     }
9206   }
9207 }
9208
9209
9210 //==========================================================================
9211 //
9212 //  ufoReset
9213 //
9214 //==========================================================================
9215 UFO_DISABLE_INLINE void ufoReset (void) {
9216   #ifdef UFO_MTASK_ALLOWED
9217   if (ufoCurrState == NULL) ufoFatal("no active execution state");
9218   #endif
9219
9220   ufoSP = 0; ufoRP = 0;
9221   ufoLP = 0; ufoLBP = 0;
9222
9223   ufoInRunWord = 0;
9224
9225   ufoInBacktrace = 0;
9226
9227   // save TIB
9228   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
9229   const uint32_t tibDef = ufoImgGetU32(ufoAddrDefTIB);
9230   #ifdef UFO_MTASK_ALLOWED
9231   ufoInitStateUserVars(ufoCurrState);
9232   #else
9233   ufoInitStateUserVars(&ufoCurrState);
9234   #endif
9235   // restore TIB
9236   ufoImgPutU32(ufoAddrTIBx, tib);
9237   ufoImgPutU32(ufoAddrDefTIB, tibDef);
9238   ufoImgPutU32(ufoAddrRedefineWarning, UFO_REDEF_WARN_NORMAL);
9239   ufoResetTib();
9240
9241   ufoImgPutU32(ufoAddrNewWordFlags, 0);
9242   ufoVocSetOnlyDefs(ufoForthVocId);
9243 }
9244
9245
9246 //==========================================================================
9247 //
9248 //  ufoDefineEmitType
9249 //
9250 //==========================================================================
9251 UFO_DISABLE_INLINE void ufoDefineEmitType (void) {
9252   // EMIT
9253   // ( ch -- )
9254   ufoInterpretLine(": EMIT  ( ch -- )  (NORM-EMIT-CHAR) (EMIT) ;");
9255
9256   // XEMIT
9257   // ( ch -- )
9258   ufoInterpretLine(": XEMIT  ( ch -- )  (NORM-XEMIT-CHAR) (EMIT) ;");
9259
9260   // CR
9261   // ( -- )
9262   ufoInterpretLine(": CR  ( -- )  NL (EMIT) ;");
9263
9264   // ENDCR
9265   // ( -- )
9266   ufoInterpretLine(
9267     ": ENDCR  ( -- ) "
9268     "  LASTCR? FORTH:(TBRANCH) $endcr-exit CR "
9269     "$endcr-exit: "
9270     ";");
9271   //ufoDecompileWord(ufoFindWordChecked("ENDCR"));
9272
9273   // SPACE
9274   // ( -- )
9275   ufoInterpretLine(": SPACE  ( -- )  BL (EMIT) ;");
9276
9277   // SPACES
9278   // ( count -- )
9279   ufoInterpretLine(
9280     ": SPACES  ( count -- ) "
9281     "$spaces-again: "
9282     "    DUP 0> FORTH:(0BRANCH) $spaces-exit "
9283     "    SPACE 1- "
9284     "    FORTH:(BRANCH) $spaces-again "
9285     "$spaces-exit: "
9286     "  DROP "
9287     ";");
9288
9289   // (TYPE)
9290   // ( addr count -- )
9291   ufoInterpretLine(
9292     ": (TYPE)  ( addr count -- ) "
9293     "  A>R SWAP >A "
9294     "$par-type-again: "
9295     "    DUP 0> FORTH:(0BRANCH) $par-type-exit "
9296     "    C@A (EMIT) +1>A "
9297     "    1- "
9298     "    FORTH:(BRANCH) $par-type-again "
9299     "$par-type-exit: "
9300     "  DROP R>A "
9301     ";");
9302
9303   // TYPE
9304   // ( addr count -- )
9305   ufoInterpretLine(
9306     ": TYPE  ( addr count -- ) "
9307     "  A>R SWAP >A "
9308     "$type-again: "
9309     "    DUP 0> FORTH:(0BRANCH) $type-exit "
9310     "    C@A EMIT +1>A "
9311     "    1- "
9312     "    FORTH:(BRANCH) $type-again "
9313     "$type-exit: "
9314     "  DROP R>A "
9315     ";");
9316
9317   // XTYPE
9318   // ( addr count -- )
9319   ufoInterpretLine(
9320     ": XTYPE  ( addr count -- ) "
9321     "  A>R SWAP >A "
9322     "$xtype-again: "
9323     "    DUP 0> FORTH:(0BRANCH) $xtype-exit "
9324     "    C@A XEMIT +1>A "
9325     "    1- "
9326     "    FORTH:(BRANCH) $xtype-again "
9327     "$xtype-exit: "
9328     "  DROP R>A "
9329     ";");
9330
9331   // STRLITERAL
9332   // ( C:addr count -- )  ( E: -- addr count )
9333   ufoInterpretLine(
9334     ": STRLITERAL  ( C:addr count -- )  ( E: -- addr count ) "
9335     "  DUP 255 U> ` string literal too long` ?ERROR "
9336     "  COMPILER:EXEC? FORTH:(TBRANCH) $strlit-exit "
9337     "  HERE >R ( addr count | here ) "
9338     "  ['] FORTH:(LITSTR8) COMPILE, "
9339     "  A>R SWAP >A "
9340     "  ( compile length ) "
9341     "  DUP C, "
9342     "  ( compile chars ) "
9343     "$strlit-loop: "
9344     "    DUP 0<> FORTH:(0BRANCH) $strlit-loop-exit "
9345     "    C@A C, +1>A  1- "
9346     "  FORTH:(BRANCH) $strlit-loop "
9347     "$strlit-loop-exit: "
9348     "  R>A "
9349     "  ( final 0: our counter is 0 here, so use it ) "
9350     "  C, ALIGN-HERE "
9351     "  R> COMPILER:(AFTER-COMPILE-WORD) "
9352     "$strlit-exit: "
9353     ";");
9354
9355   // quote
9356   // ( -- addr count )
9357   ufoInterpretLine(
9358     "!: \"  ( -- addr count ) "
9359     "  34 PARSE ` string literal expected` ?NOT-ERROR "
9360     "  COMPILER:(UNESCAPE) STRLITERAL "
9361     ";");
9362 }
9363
9364
9365 //==========================================================================
9366 //
9367 //  ufoDefineInterpret
9368 //
9369 //  define "INTERPRET" in Forth
9370 //
9371 //==========================================================================
9372 UFO_DISABLE_INLINE void ufoDefineInterpret (void) {
9373   UFWORDX("(UFO-INTERPRET-FINISHED-ACTION)", UFO_INTERPRET_FINISHED_ACTION);
9374
9375   // return "stop flag"
9376   ufoInterpretLine(
9377     "*: (UFO-INTERPRET-NEXT-LINE)  ( -- continue? ) "
9378     "  COMPILER:COMP? FORTH:(TBRANCH) $ipn_incomp "
9379     "    ( interpreter allowed to cross include boundary ) "
9380     "    REFILL FORTH:(BRANCH) $ipn_done "
9381     "$ipn_incomp: "
9382     "    ( compiler is not allowed to cross include boundary ) "
9383     "    REFILL-NOCROSS ` compiler cannot cross file boundaries` ?NOT-ERROR "
9384     "    TRUE "
9385     "$ipn_done: "
9386     ";");
9387
9388   ufoInterpNextLineCFA = ufoFindWordChecked("FORTH:(UFO-INTERPRET-NEXT-LINE)");
9389   ufoInterpretLine("*: (INTERPRET-NEXT-LINE)  (USER-INTERPRET-NEXT-LINE) @ EXECUTE-TAIL ;");
9390
9391   // skip comments, parse name, refilling lines if necessary
9392   // returning FALSE as counter means: "no addr, exit INTERPRET"
9393   ufoInterpretLine(
9394     "*: (INTERPRET-PARSE-NAME)  ( -- addr count / FALSE ) "
9395     "$label_ipn_again: "
9396     "  TRUE (PARSE-SKIP-COMMENTS) PARSE-NAME "
9397     "  DUP FORTH:(TBRANCH) $label_ipn_exit_fwd "
9398     "  2DROP (INTERPRET-NEXT-LINE) "
9399     "  FORTH:(TBRANCH) $label_ipn_again "
9400     "  FALSE "
9401     "$label_ipn_exit_fwd: "
9402     ";");
9403   //ufoDecompileWord(ufoFindWordChecked("(INTERPRET-PARSE-NAME)"));
9404
9405   ufoInterpretLine(
9406     ": INTERPRET "
9407     "$interp-again: "
9408     "  FORTH:(INTERPRET-PARSE-NAME) ( addr count / FALSE )"
9409     "  ?DUP FORTH:(0BRANCH) $interp-done "
9410     "  ( try defered checker ) "
9411     "  ( addr count FALSE -- addr count FALSE / TRUE ) "
9412     "  FALSE (INTERPRET-CHECK-WORD) FORTH:(TBRANCH) $interp-again "
9413     "  2DUP FIND-WORD  ( addr count cfa TRUE / addr count FALSE ) "
9414     "  FORTH:(0BRANCH) $interp-try-number "
9415     "  ( word found ) "
9416     "  NROT 2DROP  ( drop word string ) "
9417     "  COMPILER:EXEC? FORTH:(TBRANCH) $interp-exec "
9418     "  ( compiling; check immediate bit ) "
9419     "  DUP CFA->NFA @ COMPILER:(WFLAG-IMMEDIATE) AND FORTH:(TBRANCH) $interp-exec "
9420     "  ( compile it ) "
9421     "  FORTH:COMPILE, FORTH:(BRANCH) $interp-again "
9422     "  ( execute it ) "
9423     "$interp-exec: "
9424     "  EXECUTE FORTH:(BRANCH) $interp-again "
9425     "  ( not a word, try a number ) "
9426     "$interp-try-number: "
9427     "  2DUP TRUE BASE @ (BASED-NUMBER)  ( addr count allowsign? base -- num TRUE / FALSE ) "
9428     "  FORTH:(0BRANCH) $interp-number-error "
9429     "  ( number ) "
9430     "  NROT 2DROP  ( drop word string ) "
9431     "  LITERAL FORTH:(BRANCH) $interp-again "
9432     "  ( error ) "
9433     "$interp-number-error: "
9434     "  ( addr count FALSE -- addr count FALSE / TRUE ) "
9435     "  FALSE (INTERPRET-WORD-NOT-FOUND) FORTH:(TBRANCH) $interp-again "
9436     "  (INTERPRET-WORD-NOT-FOUND-POST) "
9437     "  ENDCR SPACE XTYPE `  -- wut?` TYPE CR "
9438     "  ` unknown word` ERROR "
9439     "$interp-done: "
9440     ";");
9441   //ufoDecompileWord(ufoFindWordChecked("INTERPRET"));
9442 }
9443
9444
9445 //==========================================================================
9446 //
9447 //  ufoInitBaseDict
9448 //
9449 //==========================================================================
9450 UFO_DISABLE_INLINE void ufoInitBaseDict (void) {
9451   uint32_t imgAddr = 0;
9452
9453   // reserve 32 bytes for nothing
9454   for (uint32_t f = 0; f < 32; f += 1) {
9455     ufoImgPutU8(imgAddr, 0);
9456     imgAddr += 1;
9457   }
9458   // align
9459   while ((imgAddr & 3) != 0) {
9460     ufoImgPutU8(imgAddr, 0);
9461     imgAddr += 1;
9462   }
9463
9464   // DP
9465   ufoAddrDP = imgAddr;
9466   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
9467
9468   // (LATEST-XFA)
9469   ufoAddrLastXFA = imgAddr;
9470   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
9471
9472   // (VOC-LINK)
9473   ufoAddrVocLink = imgAddr;
9474   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
9475
9476   // (NEW-WORD-FLAGS)
9477   ufoAddrNewWordFlags = imgAddr;
9478   ufoImgPutU32(imgAddr, UFW_FLAG_PROTECTED); imgAddr += 4u;
9479
9480   // WORD-REDEFINE-WARN-MODE
9481   ufoAddrRedefineWarning = imgAddr;
9482   ufoImgPutU32(imgAddr, UFO_REDEF_WARN_NORMAL); imgAddr += 4u;
9483
9484   // setup (DP) and (DP-TEMP)
9485   ufoImgPutU32(ufoAddrDP, imgAddr);
9486   ufoImgPutU32(ufoAddrDPTemp, UFO_DPTEMP_BASE_ADDR);
9487   ufoImgPutU32(ufoAddrHereDP, ufoAddrDP);
9488
9489   #if 0
9490   fprintf(stderr, "INITIAL HERE: 0x%08x (0x%08x)\n", imgAddr, UFO_GET_DP());
9491   #endif
9492 }
9493
9494
9495 //==========================================================================
9496 //
9497 //  ufoInitStateUserVars
9498 //
9499 //==========================================================================
9500 static void ufoInitStateUserVars (UfoState *st) {
9501   ufo_assert(st != NULL);
9502   #ifndef UFO_HUGE_IMAGES
9503   if (st->imageTempSize < 8192u) {
9504     uint32_t *itmp = realloc(st->imageTemp, 8192);
9505     if (itmp == NULL) ufoFatal("out of memory for state user area");
9506     st->imageTemp = itmp;
9507     memset((uint8_t *)st->imageTemp + st->imageTempSize, 0, 8192u - st->imageTempSize);
9508     st->imageTempSize = 8192;
9509   }
9510   #endif
9511   st->imageTemp[(ufoAddrBASE & UFO_ADDR_TEMP_MASK) / 4u] = 10;
9512   st->imageTemp[(ufoAddrSTATE & UFO_ADDR_TEMP_MASK) / 4u] = 0;
9513   st->imageTemp[(ufoAddrUserVarUsed & UFO_ADDR_TEMP_MASK) / 4u] = ufoAddrUserVarUsed;
9514   st->imageTemp[(ufoAddrDefTIB & UFO_ADDR_TEMP_MASK) / 4u] = UFO_DEF_TIB_ADDR;
9515   st->imageTemp[(ufoAddrTIBx & UFO_ADDR_TEMP_MASK) / 4u] = UFO_DEF_TIB_ADDR;
9516   st->imageTemp[(ufoAddrINx & UFO_ADDR_TEMP_MASK) / 4u] = 0;
9517   st->imageTemp[(ufoAddrContext & UFO_ADDR_TEMP_MASK) / 4u] = ufoForthVocId;
9518   st->imageTemp[(ufoAddrCurrent & UFO_ADDR_TEMP_MASK) / 4u] = ufoForthVocId;
9519   st->imageTemp[(ufoAddrSelf & UFO_ADDR_TEMP_MASK) / 4u] = 0;
9520   st->imageTemp[(ufoAddrInterNextLine & UFO_ADDR_TEMP_MASK) / 4u] = ufoInterpNextLineCFA;
9521   st->imageTemp[(ufoAddrEP & UFO_ADDR_TEMP_MASK) / 4u] = 0;
9522   st->imageTemp[(ufoAddrDPTemp & UFO_ADDR_TEMP_MASK) / 4u] = UFO_DPTEMP_BASE_ADDR;
9523   st->imageTemp[(ufoAddrHereDP & UFO_ADDR_TEMP_MASK) / 4u] = ufoAddrDP;
9524
9525   // init other things, because this procedure is used in `ufoReset()` too
9526   st->SP = 0; st->RP = 0; st->regA = 0;
9527   st->LP = 0; st->LBP = 0;
9528   st->VSP = 0;
9529 }
9530
9531
9532 //==========================================================================
9533 //
9534 //  ufoInitBasicWords
9535 //
9536 //==========================================================================
9537 UFO_DISABLE_INLINE void ufoInitBasicWords (void) {
9538   ufoDefineConstant("FALSE", 0);
9539   ufoDefineConstant("TRUE", ufoTrueValue);
9540
9541   ufoDefineConstant("BL", 32);
9542   ufoDefineConstant("NL", 10);
9543
9544   UFWORDX("NOOP", NOOP);
9545   UFWORDX("(NOTIMPL)", PAR_NOTIMPL); ufoSetLatestFlags(UFW_FLAG_NORETURN);
9546
9547   // user variables
9548   ufoDefineUserVar("BASE", ufoAddrBASE);
9549   ufoDefineUserVar("TIB", ufoAddrTIBx);
9550   ufoDefineUserVar(">IN", ufoAddrINx);
9551   ufoDefineUserVar("(STD-TIB-ADDR)", ufoAddrDefTIB);
9552   ufoDefineUserVar("(USER-VAR-USED)", ufoAddrUserVarUsed);
9553   ufoDefineConstant("(USER-VAR-ADDR)", UFO_ADDR_TEMP_BIT);
9554   ufoDefineConstant("(USER-VAR-SIZE)", UFO_USER_AREA_SIZE);
9555   ufoDefineConstant("(USER-TIB)", UFO_DEF_TIB_ADDR);
9556   ufoDefineConstant("(USER-TIB-SIZE)", UFO_ADDR_HANDLE_OFS_MASK);
9557
9558   ufoDefineUserVar("STATE", ufoAddrSTATE);
9559   ufoDefineConstant("CONTEXT", ufoAddrContext);
9560   ufoDefineConstant("CURRENT", ufoAddrCurrent);
9561   ufoDefineConstant("(SELF)", ufoAddrSelf); // used in OOP implementations
9562   ufoDefineConstant("(USER-INTERPRET-NEXT-LINE)", ufoAddrInterNextLine);
9563   ufoDefineConstant("(EXC-FRAME-PTR)", ufoAddrEP);
9564
9565   ufoHiddenWords();
9566   ufoDefineConstant("(LATEST-XFA)", ufoAddrLastXFA);
9567   ufoDefineConstant("(VOC-LINK)", ufoAddrVocLink);
9568   ufoDefineConstant("(NEW-WORD-FLAGS)", ufoAddrNewWordFlags);
9569   ufoDefineConstant("(ADDR-TEMP-BIT)", UFO_ADDR_TEMP_BIT);
9570   ufoDefineConstant("(ADDR-CFA-BIT)", UFO_ADDR_CFA_BIT);
9571   ufoDefineConstant("(ADDR-HANDLE-BIT)", UFO_ADDR_HANDLE_BIT);
9572   ufoDefineConstant("(MAX-HANDLE-OFS)", UFO_ADDR_HANDLE_OFS_MASK);
9573   ufoDefineConstant("(DP-TEMP-BASE-ADDR))", UFO_DPTEMP_BASE_ADDR);
9574
9575   ufoDefineConstant("(PAD-ADDR)", UFO_PAD_ADDR);
9576   ufoDefineConstant("(#BUF)", UFO_NBUF_ADDR + 4u); // reserve room for counter
9577   ufoDefineConstant("(#BUF-SIZE)", UFO_NBUF_SIZE - 8u);
9578
9579   ufoDefineConstant("(DP-MAIN)", ufoAddrDP);
9580   ufoDefineConstant("(DP-TEMP)", ufoAddrDPTemp); // in user vars
9581   ufoDefineConstant("(DP-HERE)", ufoAddrHereDP); // in user vars
9582   ufoPublicWords();
9583
9584   //UFWORDX("(UFO-BUCKET-STATS)", PAR_UFO_BUCKET_STATS);
9585   UFWORDX("SP0!", SP0_STORE);
9586   UFWORDX("RP0!", RP0_STORE);
9587
9588   UFWORDX("(SELF@)", PAR_SELF_LOAD);
9589   UFWORDX("(SELF!)", PAR_SELF_STORE);
9590
9591   UFWORDX("PAD", PAD);
9592   UFWORDX("HERE", HERE);
9593   UFWORDX("ALIGN-HERE", ALIGN_HERE);
9594
9595   UFWORDX("@", PEEK);
9596   UFWORDX("C@", CPEEK);
9597   UFWORDX("W@", WPEEK);
9598
9599   UFWORDX("!", POKE);
9600   UFWORDX("C!", CPOKE);
9601   UFWORDX("W!", WPOKE);
9602
9603   UFWORDX("(DIRECT:@)", DIRECT_PEEK); ufoSetLatestArgs(UFW_WARG_PFA);
9604   UFWORDX("(DIRECT:!)", DIRECT_POKE); ufoSetLatestArgs(UFW_WARG_PFA);
9605   UFWORDX("(DIRECT:0:!)", DIRECT_POKE0); ufoSetLatestArgs(UFW_WARG_PFA);
9606   UFWORDX("(DIRECT:1:!)", DIRECT_POKE1); ufoSetLatestArgs(UFW_WARG_PFA);
9607   UFWORDX("(DIRECT:-1:!)", DIRECT_POKEM1); ufoSetLatestArgs(UFW_WARG_PFA);
9608   UFWORDX("(DIRECT:+!)", DIRECT_ADD_POKE); ufoSetLatestArgs(UFW_WARG_PFA);
9609   UFWORDX("(DIRECT:-!)", DIRECT_SUB_POKE); ufoSetLatestArgs(UFW_WARG_PFA);
9610   UFWORDX("(DIRECT:+:@)", DIRECT_OFS_PEEK); ufoSetLatestArgs(UFW_WARG_LIT);
9611   UFWORDX("(DIRECT:+:!)", DIRECT_OFS_POKE); ufoSetLatestArgs(UFW_WARG_LIT);
9612   UFWORDX("(DIRECT:1+!)", DIRECT_POKE_INC1); ufoSetLatestArgs(UFW_WARG_LIT);
9613   UFWORDX("(DIRECT:2+!)", DIRECT_POKE_INC2); ufoSetLatestArgs(UFW_WARG_LIT);
9614   UFWORDX("(DIRECT:4+!)", DIRECT_POKE_INC4); ufoSetLatestArgs(UFW_WARG_LIT);
9615   UFWORDX("(DIRECT:8+!)", DIRECT_POKE_INC8); ufoSetLatestArgs(UFW_WARG_LIT);
9616   UFWORDX("(DIRECT:1-!)", DIRECT_POKE_DEC1); ufoSetLatestArgs(UFW_WARG_LIT);
9617   UFWORDX("(DIRECT:2-!)", DIRECT_POKE_DEC2); ufoSetLatestArgs(UFW_WARG_LIT);
9618   UFWORDX("(DIRECT:4-!)", DIRECT_POKE_DEC4); ufoSetLatestArgs(UFW_WARG_LIT);
9619   UFWORDX("(DIRECT:8-!)", DIRECT_POKE_DEC8); ufoSetLatestArgs(UFW_WARG_LIT);
9620
9621   UFWORDX("(LIT-AND)", LIT_AND); ufoSetLatestArgs(UFW_WARG_LIT);
9622   UFWORDX("(LIT-~AND)", LIT_NAND); ufoSetLatestArgs(UFW_WARG_LIT);
9623   UFWORDX("(LIT-OR)", LIT_OR); ufoSetLatestArgs(UFW_WARG_LIT);
9624   UFWORDX("(LIT-XOR)", LIT_XOR); ufoSetLatestArgs(UFW_WARG_LIT);
9625
9626   UFWORDX("0!", POKE_0);
9627   UFWORDX("1!", POKE_1);
9628   UFWORDX("1+!", POKE_INC_1);
9629   UFWORDX("1-!", POKE_DEC_1);
9630   UFWORDX("+!", POKE_INC);
9631   UFWORDX("-!", POKE_DEC);
9632
9633   UFWORDX("SWAP!", SWAP_POKE);
9634   UFWORDX("SWAP-C!", SWAP_CPOKE);
9635   UFWORDX("SWAP-W!", SWAP_WPOKE);
9636   UFWORDX("OR!", OR_POKE);
9637   UFWORDX("OR-C!", OR_CPOKE);
9638   UFWORDX("OR-W!", OR_WPOKE);
9639   UFWORDX("XOR!", XOR_POKE);
9640   UFWORDX("XOR-C!", XOR_CPOKE);
9641   UFWORDX("XOR-W!", XOR_WPOKE);
9642   UFWORDX("~AND!", NAND_POKE);
9643   UFWORDX("~AND-C!", NAND_CPOKE);
9644   UFWORDX("~AND-W!", NAND_WPOKE);
9645
9646   UFWORDX("COUNT", COUNT);
9647   UFWORDX("BCOUNT", BCOUNT);
9648   UFWORDX("ID-COUNT", ID_COUNT);
9649
9650   UFWORDX(",", COMMA);
9651   UFWORDX("C,", CCOMMA);
9652   UFWORDX("W,", WCOMMA);
9653
9654   UFWORDX("A>", REGA_LOAD);
9655   UFWORDX(">A", REGA_STORE);
9656   UFWORDX("A-SWAP", REGA_SWAP);
9657   UFWORDX("+1>A", REGA_INC);
9658   UFWORDX("+2>A", REGA_INC_WORD);
9659   UFWORDX("+4>A", REGA_INC_CELL);
9660   UFWORDX("-1>A", REGA_DEC);
9661   UFWORDX("-2>A", REGA_DEC_WORD);
9662   UFWORDX("-4>A", REGA_DEC_CELL);
9663   UFWORDX("A>R", REGA_TO_R);
9664   UFWORDX("R>A", R_TO_REGA);
9665
9666   UFWORDX("@A", PEEK_REGA);
9667   UFWORDX("C@A", CPEEK_REGA);
9668   UFWORDX("W@A", WPEEK_REGA);
9669
9670   UFWORDX("!A", POKE_REGA);
9671   UFWORDX("C!A", CPOKE_REGA);
9672   UFWORDX("W!A", WPOKE_REGA);
9673
9674   UFWORDX("@A+", PEEK_REGA_IDX);
9675   UFWORDX("C@A+", CPEEK_REGA_IDX);
9676   UFWORDX("W@A+", WPEEK_REGA_IDX);
9677
9678   UFWORDX("!A+", POKE_REGA_IDX);
9679   UFWORDX("C!A+", CPOKE_REGA_IDX);
9680   UFWORDX("W!A+", WPOKE_REGA_IDX);
9681
9682   UFWORDX("C!+1>A", CPOKE_REGA_INC1);
9683   UFWORDX("W!+2>A", WPOKE_REGA_INC2);
9684   UFWORDX("!+4>A", POKE_REGA_INC4);
9685   UFWORDX("C@+1>A", CPEEK_REGA_INC1);
9686   UFWORDX("W@+2>A", WPEEK_REGA_INC2);
9687   UFWORDX("@+4>A", PEEK_REGA_INC4);
9688
9689   ufoHiddenWords();
9690   UFWORDX("(LIT)", PAR_LIT); ufoSetLatestArgs(UFW_WARG_LIT);
9691   UFWORDX("(LITCFA)", PAR_LITCFA); ufoSetLatestArgs(UFW_WARG_CFA);
9692   UFWORDX("(LITPFA)", PAR_LITPFA); ufoSetLatestArgs(UFW_WARG_PFA);
9693   UFWORDX("(LITVOCID)", PAR_LITVOCID); ufoSetLatestArgs(UFW_WARG_VOCID);
9694   UFWORDX("(LITSTR8)", PAR_LITSTR8); ufoSetLatestArgs(UFW_WARG_C1STRZ);
9695   UFWORDX("(EXIT)", PAR_EXIT); ufoSetLatestFlags(UFW_FLAG_NORETURN);
9696
9697   ufoLitStr8CFA = ufoFindWordChecked("FORTH:(LITSTR8)");
9698
9699   UFWORDX("(L-ENTER)", PAR_LENTER); ufoSetLatestArgs(UFW_WARG_LIT);
9700   UFWORDX("(L-LEAVE)", PAR_LLEAVE);
9701   UFWORDX("(LOCAL@)", PAR_LOCAL_LOAD);
9702   UFWORDX("(LOCAL!)", PAR_LOCAL_STORE);
9703
9704   UFWORDX("(BRANCH)", PAR_BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
9705   UFWORDX("(TBRANCH)", PAR_TBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); ufoSetLatestFlags(UFW_WARG_CONDBRANCH);
9706   UFWORDX("(0BRANCH)", PAR_0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); ufoSetLatestFlags(UFW_WARG_CONDBRANCH);
9707   UFWORDX("(+0BRANCH)", PAR_P0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); ufoSetLatestFlags(UFW_WARG_CONDBRANCH);
9708   UFWORDX("(+BRANCH)", PAR_PBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); ufoSetLatestFlags(UFW_WARG_CONDBRANCH);
9709   UFWORDX("(-0BRANCH)", PAR_M0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); ufoSetLatestFlags(UFW_WARG_CONDBRANCH);
9710   UFWORDX("(-BRANCH)", PAR_MBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); ufoSetLatestFlags(UFW_WARG_CONDBRANCH);
9711   UFWORDX("(DATASKIP)", PAR_DATASKIP); ufoSetLatestArgs(UFW_WARG_DATASKIP);
9712   UFWORDX("(OR-BRANCH)", PAR_OR_BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); ufoSetLatestFlags(UFW_WARG_CONDBRANCH);
9713   UFWORDX("(AND-BRANCH)", PAR_AND_BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); ufoSetLatestFlags(UFW_WARG_CONDBRANCH);
9714   UFWORDX("(?DUP-0BRANCH)", PAR_QDUP_0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); ufoSetLatestFlags(UFW_WARG_CONDBRANCH);
9715   UFWORDX("(CASE-BRANCH)", PAR_CASE_BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH); ufoSetLatestFlags(UFW_WARG_CONDBRANCH);
9716   ufoPublicWords();
9717 }
9718
9719
9720 //==========================================================================
9721 //
9722 //  ufoInitMoreWords
9723 //
9724 //==========================================================================
9725 UFO_DISABLE_INLINE void ufoInitMoreWords (void) {
9726   UFWORDX("CFA->DOES-CFA", CFA2DOESCFA);
9727   UFWORDX("CFA->PFA", CFA2PFA);
9728   UFWORDX("CFA->NFA", CFA2NFA);
9729   UFWORDX("CFA->LFA", CFA2LFA);
9730   UFWORDX("CFA->WEND", CFA2WEND);
9731
9732   UFWORDX("PFA->CFA", PFA2CFA);
9733   UFWORDX("PFA->NFA", PFA2NFA);
9734
9735   UFWORDX("NFA->CFA", NFA2CFA);
9736   UFWORDX("NFA->PFA", NFA2PFA);
9737   UFWORDX("NFA->LFA", NFA2LFA);
9738
9739   UFWORDX("LFA->CFA", LFA2CFA);
9740   UFWORDX("LFA->PFA", LFA2PFA);
9741   UFWORDX("LFA->BFA", LFA2BFA);
9742   UFWORDX("LFA->XFA", LFA2XFA);
9743   UFWORDX("LFA->YFA", LFA2YFA);
9744   UFWORDX("LFA->NFA", LFA2NFA);
9745
9746   UFWORDX("(BASED-NUMBER)", PAR_BASED_NUMBER);
9747   UFWORDX("FIND-WORD", FIND_WORD);
9748   UFWORDX("(FIND-WORD-IN-VOC)", PAR_FIND_WORD_IN_VOC);
9749   UFWORDX("(FIND-WORD-IN-VOC-AND-PARENTS)", PAR_FIND_WORD_IN_VOC_AND_PARENTS);
9750   UFWORDX("FIND-WORD-IN-VOC", FIND_WORD_IN_VOC);
9751   UFWORDX("FIND-WORD-IN-VOC-AND-PARENTS", FIND_WORD_IN_VOC_AND_PARENTS);
9752
9753   UFWORD(EXECUTE);
9754   UFWORDX("EXECUTE-TAIL", EXECUTE_TAIL); ufoSetLatestFlags(UFW_FLAG_NORETURN);
9755   UFWORDX("@EXECUTE", LOAD_EXECUTE);
9756   UFWORDX("@EXECUTE-TAIL", LOAD_EXECUTE_TAIL); ufoSetLatestFlags(UFW_FLAG_NORETURN);
9757   UFWORDX("(FORTH-CALL)", FORTH_CALL);
9758   UFWORDX("(FORTH-TAIL-CALL)", FORTH_TAIL_CALL); ufoSetLatestFlags(UFW_FLAG_NORETURN);
9759
9760   UFWORD(DUP);
9761   UFWORD(NIP);
9762   UFWORD(TUCK);
9763   UFWORDX("?DUP", QDUP);
9764   UFWORDX("2DUP", DDUP);
9765   UFWORD(DROP);
9766   UFWORDX("2DROP", DDROP);
9767   UFWORD(SWAP);
9768   UFWORDX("2SWAP", DSWAP);
9769   UFWORD(OVER);
9770   UFWORDX("2OVER", DOVER);
9771   UFWORD(ROT);
9772   UFWORD(NROT);
9773   UFWORDX("PICK", PICK);
9774   UFWORDX("ROLL", ROLL);
9775
9776   UFWORD(RDUP);
9777   UFWORD(RDROP);
9778   UFWORDX(">R", DTOR);
9779   UFWORDX("R>", RTOD);
9780   UFWORDX("R@", RPEEK);
9781   UFWORDX("2>R", 2DTOR);
9782   UFWORDX("2R>", 2RTOD);
9783   UFWORDX("2R@", 2RPEEK);
9784   UFWORDX("2RDROP", 2RDROP);
9785   UFWORDX("RPICK", RPICK);
9786   UFWORDX("RROLL", RROLL);
9787   UFWORDX("RSWAP", RSWAP);
9788   UFWORDX("ROVER", ROVER);
9789   UFWORDX("RROT", RROT);
9790   UFWORDX("RNROT", RNROT);
9791
9792   UFWORDX("FLUSH-EMIT", FLUSH_EMIT);
9793   UFWORDX("(EMIT)", PAR_EMIT);
9794   UFWORDX("(NORM-EMIT-CHAR)", PAR_NORM_EMIT_CHAR);
9795   UFWORDX("(NORM-XEMIT-CHAR)", PAR_NORM_XEMIT_CHAR);
9796   UFWORDX("LASTCR?", LASTCRQ);
9797   UFWORDX("LASTCR!", LASTCRSET);
9798
9799   // simple math
9800   UFWORDX("+", PLUS);
9801   UFWORDX("-", MINUS);
9802   UFWORDX("*", MUL);
9803   UFWORDX("U*", UMUL);
9804   UFWORDX("/", DIV);
9805   UFWORDX("U/", UDIV);
9806   UFWORDX("MOD", MOD);
9807   UFWORDX("UMOD", UMOD);
9808   UFWORDX("/MOD", DIVMOD);
9809   UFWORDX("U/MOD", UDIVMOD);
9810   UFWORDX("*/", MULDIV);
9811   UFWORDX("U*/", UMULDIV);
9812   UFWORDX("*/MOD", MULDIVMOD);
9813   UFWORDX("U*/MOD", UMULDIVMOD);
9814   UFWORDX("M*", MMUL);
9815   UFWORDX("UM*", UMMUL);
9816   UFWORDX("M/MOD", MDIVMOD);
9817   UFWORDX("UM/MOD", UMDIVMOD);
9818   UFWORDX("UDS*", UDSMUL);
9819
9820   UFWORDX("SM/REM", SMREM);
9821   UFWORDX("FM/MOD", FMMOD);
9822
9823   UFWORDX("D-", DMINUS);
9824   UFWORDX("D+", DPLUS);
9825   UFWORDX("D=", DEQU);
9826   UFWORDX("D<", DLESS);
9827   UFWORDX("D<=", DLESSEQU);
9828   UFWORDX("DU<", DULESS);
9829   UFWORDX("DU<=", DULESSEQU);
9830
9831   UFWORD(ASH);
9832   UFWORD(LSH);
9833   UFWORD(ARSHIFT);
9834   UFWORD(LSHIFT);
9835   UFWORD(RSHIFT);
9836
9837   UFWORDX("~AND", BN_AND);
9838   UFWORDX("ABS", ABS);
9839   UFWORDX("NEGATE", NEGATE);
9840   UFWORDX("SIGN?", SIGNQ);
9841   UFWORDX("LO-WORD", LO_WORD);
9842   UFWORDX("HI-WORD", HI_WORD);
9843   UFWORDX("LO-BYTE", LO_BYTE);
9844   UFWORDX("HI-BYTE", HI_BYTE);
9845   UFWORDX("MIN", MIN);
9846   UFWORDX("MAX", MAX);
9847   UFWORDX("UMIN", UMIN);
9848   UFWORDX("UMAX", UMAX);
9849   UFWORDX("WITHIN", WITHIN);
9850   UFWORDX("UWITHIN", UWITHIN);
9851   UFWORDX("BOUNDS?", BOUNDSQ);
9852   UFWORDX("BSWAP16", BSWAP16);
9853   UFWORDX("BSWAP32", BSWAP32);
9854
9855   // for optimiser
9856   UFWORDX("(SWAP:1+:SWAP)", PAR_SWAP_INC_SWAP);
9857
9858   // logic
9859   UFWORDX("<", LESS);
9860   UFWORDX(">", GREAT);
9861   UFWORDX("<=", LESSEQU);
9862   UFWORDX(">=", GREATEQU);
9863   UFWORDX("U<", ULESS);
9864   UFWORDX("U>", UGREAT);
9865   UFWORDX("U<=", ULESSEQU);
9866   UFWORDX("U>=", UGREATEQU);
9867   UFWORDX("=", EQU);
9868   UFWORDX("<>", NOTEQU);
9869
9870   UFWORDX("0=", ZERO_EQU);
9871   UFWORDX("0<>", ZERO_NOTEQU);
9872   UFWORDX("0<", 0LESS);
9873   UFWORDX("0>", 0GREAT);
9874   UFWORDX("0<=", 0LESSEQU);
9875   UFWORDX("0>=", 0GREATEQU);
9876
9877   UFWORDX("NOT", ZERO_EQU);
9878   UFWORDX("NOTNOT", ZERO_NOTEQU);
9879
9880   UFWORD(BITNOT);
9881   UFWORD(AND);
9882   UFWORD(OR);
9883   UFWORD(XOR);
9884   UFWORDX("LOGAND", LOGAND);
9885   UFWORDX("LOGOR", LOGOR);
9886
9887   UFWORDX("2*", 2MUL);
9888   UFWORDX("4*", 4MUL);
9889   UFWORDX("8*", 8MUL);
9890   UFWORDX("2/", 2DIV);
9891   UFWORDX("4/", 4DIV);
9892   UFWORDX("8/", 8DIV);
9893   UFWORDX("2U/", 2UDIV);
9894   UFWORDX("4U/", 4UDIV);
9895   UFWORDX("8U/", 8UDIV);
9896
9897   UFWORDX("1+", 1ADD);
9898   UFWORDX("1-", 1SUB);
9899   UFWORDX("2+", 2ADD);
9900   UFWORDX("2-", 2SUB);
9901   UFWORDX("4+", 4ADD);
9902   UFWORDX("4-", 4SUB);
9903   UFWORDX("8+", 8ADD);
9904   UFWORDX("8-", 8SUB);
9905
9906   ufoDefineConstant("CELL", 4);
9907
9908   UFWORDX("CELL+", 4ADD);
9909   UFWORDX("CELL-", 4SUB);
9910
9911   UFWORDX("CELLS", 4MUL);
9912   UFWORDX("/CELLS", 4DIV);
9913   UFWORDX("+CELLS", ADD_CELLS);
9914   UFWORDX("-CELLS", SUB_CELLS);
9915
9916   UFWORDX("MEMCMP", MEMCMP);
9917   UFWORDX("MEMCMP-CI", MEMCMP_CI);
9918
9919   UFWORDX("CMOVE-CELLS", CMOVE_CELLS_FWD);
9920   UFWORDX("CMOVE>-CELLS", CMOVE_CELLS_BWD);
9921   UFWORDX("CMOVE", CMOVE_FWD);
9922   UFWORDX("CMOVE>", CMOVE_BWD);
9923   UFWORDX("MOVE", MOVE);
9924
9925   UFWORDX("FILL-CELLS", FILL_CELLS);
9926   UFWORDX("FILL", FILL);
9927
9928   // TIB and parser
9929   UFWORDX("(TIB-IN)", TIB_IN);
9930   UFWORDX("TIB-PEEKCH", TIB_PEEKCH);
9931   UFWORDX("TIB-PEEKCH-OFS", TIB_PEEKCH_OFS);
9932   UFWORDX("TIB-GETCH", TIB_GETCH);
9933   UFWORDX("TIB-SKIPCH", TIB_SKIPCH);
9934
9935   UFWORDX("REFILL", REFILL);
9936   UFWORDX("REFILL-NOCROSS", REFILL_NOCROSS);
9937
9938   ufoHiddenWords();
9939   UFWORDX("(PARSE)", PAR_PARSE);
9940   UFWORDX("(PARSE-SKIP-COMMENTS)", PAR_PARSE_SKIP_COMMENTS);
9941   ufoPublicWords();
9942   UFWORDX("PARSE-SKIP-BLANKS", PARSE_SKIP_BLANKS);
9943   UFWORDX("PARSE-NAME", PARSE_NAME);
9944   UFWORDX("PARSE-SKIP-LINE", PARSE_SKIP_LINE);
9945   UFWORDX("PARSE", PARSE);
9946
9947   ufoHiddenWords();
9948   UFWORDX("(VSP@)", PAR_GET_VSP);
9949   UFWORDX("(VSP!)", PAR_SET_VSP);
9950   UFWORDX("(VSP-AT@)", PAR_VSP_LOAD);
9951   UFWORDX("(VSP-AT!)", PAR_VSP_STORE);
9952   ufoDefineConstant("(VSP-SIZE)", UFO_VOCSTACK_SIZE);
9953
9954   ufoDefineConstant("(SP-SIZE)", UFO_DSTACK_SIZE);
9955   ufoDefineConstant("(RP-SIZE)", UFO_RSTACK_SIZE);
9956   ufoDefineConstant("(LP-SIZE)", UFO_LSTACK_SIZE);
9957   ufoPublicWords();
9958
9959   UFWORDX("ERROR", ERROR); ufoSetLatestFlags(UFW_FLAG_NORETURN);
9960   UFWORDX("FATAL-ERROR", ERROR); ufoSetLatestFlags(UFW_FLAG_NORETURN);
9961   UFWORDX("(USER-ABORT)", PAR_USER_ABORT); ufoSetLatestFlags(UFW_FLAG_NORETURN);
9962
9963   ufoUserAbortCFA = ufoImgGetU32(ufoAddrCurrent);
9964   ufoUserAbortCFA = ufoImgGetU32(ufoUserAbortCFA + UFW_VOCAB_OFS_LATEST);
9965   ufoUserAbortCFA = UFO_LFA_TO_CFA(ufoUserAbortCFA);
9966
9967   UFWORDX("?ERROR", QERROR); ufoSetLatestFlags(UFW_FLAG_MAYRETURN);
9968   UFWORDX("?NOT-ERROR", QNOTERROR); ufoSetLatestFlags(UFW_FLAG_MAYRETURN);
9969
9970   // ABORT
9971   // ( -- )
9972   ufoInterpretLine(": ABORT  ` \"ABORT\" called` ERROR ;"); ufoSetLatestFlags(UFW_FLAG_NORETURN);
9973
9974   UFWORDX("GET-MSECS", GET_MSECS);
9975 }
9976
9977
9978 //==========================================================================
9979 //
9980 //  ufoInitBasicCompilerWords
9981 //
9982 //==========================================================================
9983 UFO_DISABLE_INLINE void ufoInitBasicCompilerWords (void) {
9984   // create "COMPILER" vocabulary
9985   ufoCompilerVocId = ufoCreateVoc("COMPILER", 0, UFW_FLAG_PROTECTED);
9986   ufoVocSetOnlyDefs(ufoCompilerVocId);
9987
9988   ufoDefineConstant("(CFAIDX-DO-FORTH)", ufoDoForthCFA);
9989   ufoDefineConstant("(CFAIDX-DO-VAR)", ufoDoVariableCFA);
9990   ufoDefineConstant("(CFAIDX-DO-VALUE)", ufoDoValueCFA);
9991   ufoDefineConstant("(CFAIDX-DO-CONST)", ufoDoConstCFA);
9992   ufoDefineConstant("(CFAIDX-DO-DEFER)", ufoDoDeferCFA);
9993   ufoDefineConstant("(CFAIDX-DO-DOES)", ufoDoDoesCFA);
9994   ufoDefineConstant("(CFAIDX-DO-REDIRECT)", ufoDoRedirectCFA);
9995   ufoDefineConstant("(CFAIDX-DO-VOC)", ufoDoVocCFA);
9996   ufoDefineConstant("(CFAIDX-DO-CREATE)", ufoDoCreateCFA);
9997   ufoDefineConstant("(CFAIDX-DO-USER-VAR)", ufoDoUserVariableCFA);
9998
9999   ufoDefineConstant("(WFLAG-IMMEDIATE)", UFW_FLAG_IMMEDIATE);
10000   ufoDefineConstant("(WFLAG-SMUDGE)", UFW_FLAG_SMUDGE);
10001   ufoDefineConstant("(WFLAG-NORETURN)", UFW_FLAG_NORETURN);
10002   ufoDefineConstant("(WFLAG-HIDDEN)", UFW_FLAG_HIDDEN);
10003   ufoDefineConstant("(WFLAG-CBLOCK)", UFW_FLAG_CBLOCK);
10004   ufoDefineConstant("(WFLAG-VOCAB)", UFW_FLAG_VOCAB);
10005   ufoDefineConstant("(WFLAG-SCOLON)", UFW_FLAG_SCOLON);
10006   ufoDefineConstant("(WFLAG-PROTECTED)", UFW_FLAG_PROTECTED);
10007   ufoDefineConstant("(WFLAG-CONDBRANCH)", UFW_WARG_CONDBRANCH);
10008   ufoDefineConstant("(WFLAG-MAYRETURN)", UFW_FLAG_MAYRETURN);
10009
10010   ufoDefineConstant("(WARG-MASK)", UFW_WARG_MASK);
10011   ufoDefineConstant("(WARG-NONE)", UFW_WARG_NONE);
10012   ufoDefineConstant("(WARG-BRANCH)", UFW_WARG_BRANCH);
10013   ufoDefineConstant("(WARG-LIT)", UFW_WARG_LIT);
10014   ufoDefineConstant("(WARG-C4STRZ)", UFW_WARG_C4STRZ);
10015   ufoDefineConstant("(WARG-CFA)", UFW_WARG_CFA);
10016   ufoDefineConstant("(WARG-CBLOCK)", UFW_WARG_CBLOCK);
10017   ufoDefineConstant("(WARG-VOCID)", UFW_WARG_VOCID);
10018   ufoDefineConstant("(WARG-C1STRZ)", UFW_WARG_C1STRZ);
10019   ufoDefineConstant("(WARG-DATASKIP)", UFW_WARG_DATASKIP);
10020   ufoDefineConstant("(WARG-PFA)", UFW_WARG_PFA);
10021
10022   ufoDefineConstant("(VOCOFS-LATEST)", UFW_VOCAB_OFS_LATEST);
10023   ufoDefineConstant("(VOCOFS-VOCLINK)", UFW_VOCAB_OFS_VOCLINK);
10024   ufoDefineConstant("(VOCOFS-PARENT)", UFW_VOCAB_OFS_PARENT);
10025   ufoDefineConstant("(VOCOFS-HEADER)", UFW_VOCAB_OFS_HEADER);
10026   ufoDefineConstant("(VOCOFS-HTABLE)", UFW_VOCAB_OFS_HTABLE);
10027   ufoDefineConstant("(VOC-HTABLE-SIZE)", UFO_HASHTABLE_SIZE);
10028   ufoDefineConstant("(VOC-HTABLE-NOFLAG)", UFO_NO_HTABLE_FLAG);
10029
10030   ufoDefineConstant("(REDEFINE-WARN-DON'T-CARE)", UFO_REDEF_WARN_DONT_CARE);
10031   ufoDefineConstant("(REDEFINE-WARN-NONE)", UFO_REDEF_WARN_NONE);
10032   ufoDefineConstant("(REDEFINE-WARN-NORMAL)", UFO_REDEF_WARN_NORMAL);
10033   ufoDefineConstant("(REDEFINE-WARN-PARENTS)", UFO_REDEF_WARN_PARENTS);
10034
10035   ufoDefineConstant("WORD-REDEFINE-WARN-MODE", ufoAddrRedefineWarning);
10036
10037   UFWORDX("(BRANCH-ADDR!)", PAR_BRANCH_ADDR_POKE);
10038   UFWORDX("(BRANCH-ADDR@)", PAR_BRANCH_ADDR_PEEK);
10039
10040   UFWORDX("CFA,", CFA_COMMA);
10041   UFWORDX("(UNESCAPE)", PAR_UNESCAPE);
10042
10043   const uint32_t dropCFA = ufoFindWordChecked("FORTH:DROP");
10044   const uint32_t noopCFA = ufoFindWordChecked("FORTH:NOOP");
10045
10046   ufoDefineDefer("(AFTER-COMPILE-WORD)", dropCFA); // ( start-addr -- )
10047   ufoDefineDefer("(AFTER-COMPILE-LIT)", dropCFA); // ( start-addr -- )
10048   ufoDefineDefer("(JUMP-HERE-MARKED)", noopCFA); // ( -- )
10049   ufoDefineDefer("(RESET-SINOPT)", noopCFA); // ( -- )
10050
10051   ufoInterpretLine(
10052     ": ?EXEC  ( -- ) "
10053     "  FORTH:STATE FORTH:@ ` expecting interpretation mode` FORTH:?ERROR "
10054     ";");
10055
10056   ufoInterpretLine(
10057     ": ?COMP  ( -- ) "
10058     "  FORTH:STATE FORTH:@ ` expecting compilation mode` FORTH:?NOT-ERROR "
10059     ";");
10060
10061   ufoInterpretLine(
10062     ": EXEC?  ( -- bool ) "
10063     "  FORTH:STATE FORTH:@ FORTH:0= "
10064     ";");
10065
10066   ufoInterpretLine(
10067     ": COMP?  ( -- bool ) "
10068     "  FORTH:STATE FORTH:@ FORTH:0<> "
10069     ";");
10070
10071   ufoInterpretLine(
10072     ": EXEC!  ( -- ) "
10073     "  FORTH:STATE FORTH:0! "
10074     ";");
10075
10076   ufoInterpretLine(
10077     ": COMP!  ( -- ) "
10078     "  FORTH:STATE FORTH:1! "
10079     ";");
10080
10081   UFWORDX("(CREATE-WORD-HEADER)", PAR_CREATE_WORD_HEADER);
10082   UFWORDX("(CREATE-NAMELESS-WORD-HEADER)", PAR_CREATE_NAMELESS_WORD_HEADER);
10083
10084   ufoVocSetOnlyDefs(ufoForthVocId);
10085
10086   // [
10087   ufoInterpretLine("!: [  COMPILER:?COMP COMPILER:EXEC! ;");
10088   // ]
10089   ufoInterpretLine(": ]  COMPILER:?EXEC COMPILER:COMP! ;");
10090
10091   ufoInterpretLine(
10092     ": COMPILE,  ( n -- ) "
10093     "  HERE >R , R> COMPILER:(AFTER-COMPILE-WORD) "
10094     ";");
10095
10096   ufoInterpretLine(
10097     ": COMPILE-IMM,  ( n -- ) "
10098     "  , "
10099     ";");
10100
10101   ufoDefineVar("(COMPILE-START-HERE)", 0);
10102
10103   ufoInterpretLine(
10104     ": COMPILE-START,  ( n -- ) "
10105     "  HERE (COMPILE-START-HERE) ! , "
10106     ";");
10107
10108   ufoInterpretLine(
10109     ": COMPILE-ARG,  ( n -- ) "
10110     "  , "
10111     ";");
10112
10113   ufoInterpretLine(
10114     ": COMPILE-END,  ( n -- ) "
10115     "  , (COMPILE-START-HERE) @ (COMPILE-START-HERE) 0! "
10116     "  COMPILER:(AFTER-COMPILE-WORD) "
10117     ";");
10118
10119   // LITERAL
10120   // ( C:n -- )  ( E:n -- n )
10121   ufoInterpretLine(
10122     ": LITERAL  ( C:n -- )  ( E:n -- n ) "
10123     "  COMPILER:COMP? FORTH:(0BRANCH) $literal_exit "
10124     "  HERE >R X-COMPILE FORTH:(LIT) , "
10125     "  R> COMPILER:(AFTER-COMPILE-LIT) "
10126     "$literal_exit: "
10127     ";");
10128   //ufoDecompileWord(ufoFindWordChecked("LITERAL"));
10129
10130   // CFALITERAL
10131   // ( C:cfa -- )  ( E:cfa -- cfa )
10132   ufoInterpretLine(
10133     ": CFALITERAL  ( C:cfa -- )  ( E:cfa -- cfa ) "
10134     "  COMPILER:COMP? FORTH:(0BRANCH) $cfa_literal_exit "
10135     "  HERE >R X-COMPILE FORTH:(LITCFA) , "
10136     "  R> COMPILER:(AFTER-COMPILE-LIT) "
10137     "$cfa_literal_exit: "
10138     ";");
10139
10140   // PFALITERAL
10141   // ( C:pfa -- )  ( E:pfa -- pfa )
10142   ufoInterpretLine(
10143     ": PFALITERAL  ( C:pfa -- )  ( E:pfa -- pfa ) "
10144     "  COMPILER:COMP? FORTH:(0BRANCH) $pfa_literal_exit "
10145     "  HERE >R X-COMPILE FORTH:(LITPFA) , "
10146     "  R> COMPILER:(AFTER-COMPILE-LIT) "
10147     "$pfa_literal_exit: "
10148     ";");
10149
10150   ufoInterpretLine("!: IMM-LITERAL  LITERAL ;");
10151   ufoInterpretLine("!: IMM-CFALITERAL  CFALITERAL ;");
10152   ufoInterpretLine("!: IMM-PFALITERAL  PFALITERAL ;");
10153 }
10154
10155
10156 //==========================================================================
10157 //
10158 //  ufoInitHandleWords
10159 //
10160 //==========================================================================
10161 UFO_DISABLE_INLINE void ufoInitHandleWords (void) {
10162   // create "HANDLE" vocabulary
10163   const uint32_t handleVocId = ufoCreateVoc("HANDLE", 0, UFW_FLAG_PROTECTED);
10164   ufoVocSetOnlyDefs(handleVocId);
10165   UFWORDX("NEW", PAR_NEW_HANDLE);
10166   UFWORDX("FREE", PAR_FREE_HANDLE);
10167   UFWORDX("TYPEID@", PAR_HANDLE_GET_TYPEID);
10168   UFWORDX("TYPEID!", PAR_HANDLE_SET_TYPEID);
10169   UFWORDX("SIZE@", PAR_HANDLE_GET_SIZE);
10170   UFWORDX("SIZE!", PAR_HANDLE_SET_SIZE);
10171   UFWORDX("USED@", PAR_HANDLE_GET_USED);
10172   UFWORDX("USED!", PAR_HANDLE_SET_USED);
10173   UFWORDX("C@", PAR_HANDLE_LOAD_BYTE);
10174   UFWORDX("W@", PAR_HANDLE_LOAD_WORD);
10175   UFWORDX("@", PAR_HANDLE_LOAD_CELL);
10176   UFWORDX("C!", PAR_HANDLE_STORE_BYTE);
10177   UFWORDX("W!", PAR_HANDLE_STORE_WORD);
10178   UFWORDX("!", PAR_HANDLE_STORE_CELL);
10179   UFWORDX("LOAD-FILE", PAR_HANDLE_LOAD_FILE);
10180   ufoVocSetOnlyDefs(ufoForthVocId);
10181 }
10182
10183
10184 //==========================================================================
10185 //
10186 //  ufoInitHigherWords
10187 //
10188 //==========================================================================
10189 UFO_DISABLE_INLINE void ufoInitHigherWords (void) {
10190   UFWORDX("(INCLUDE)", PAR_INCLUDE);
10191   UFWORDX("(INCLUDE-DROP)", PAR_INCLUDE_DROP);
10192   UFWORDX("(INCLUDE-BUILD-NAME)", PAR_INCLUDE_BUILD_NAME);
10193   UFWORDX("(INCLUDE-NO-REFILL)", PAR_INCLUDE_NO_REFILL);
10194   UFWORDX("(INCLUDE-LINE-SEEK)", PAR_INCLUDE_LINE_SEEK);
10195
10196   UFWORDX("(INCLUDE-LINE-FOFS)", PAR_INCLUDE_LINE_FOFS);
10197   UFWORDX("(INCLUDE-DEPTH)", PAR_INCLUDE_DEPTH);
10198   UFWORDX("(INCLUDE-FILE-ID)", PAR_INCLUDE_FILE_ID);
10199   UFWORDX("(INCLUDE-FILE-LINE)", PAR_INCLUDE_FILE_LINE);
10200   UFWORDX("(INCLUDE-FILE-NAME)", PAR_INCLUDE_FILE_NAME);
10201
10202   UFWORDX("($DEFINED?)", PAR_DLR_DEFINEDQ);
10203   UFWORDX("($DEFINE)", PAR_DLR_DEFINE);
10204   UFWORDX("($UNDEF)", PAR_DLR_UNDEF);
10205
10206   UFWORDX_IMM("$INCLUDE", DLR_INCLUDE_IMM);
10207   UFWORDX_IMM("$INCLUDE-ONCE", DLR_INCLUDE_ONCE_IMM);
10208 }
10209
10210
10211 //==========================================================================
10212 //
10213 //  ufoInitStringWords
10214 //
10215 //==========================================================================
10216 UFO_DISABLE_INLINE void ufoInitStringWords (void) {
10217   // create "STRING" vocabulary
10218   const uint32_t stringVocId = ufoCreateVoc("STRING", 0, UFW_FLAG_PROTECTED);
10219   ufoVocSetOnlyDefs(stringVocId);
10220   UFWORDX("=", STREQU);
10221   UFWORDX("=CI", STREQUCI);
10222   UFWORDX("SEARCH", SEARCH);
10223   UFWORDX("HASH", STRHASH);
10224   UFWORDX("HASH-CI", STRHASHCI);
10225   UFWORDX("CHAR-UPPER", CHAR_UPPER);
10226   UFWORDX("CHAR-LOWER", CHAR_LOWER);
10227   UFWORDX("UPPER", STRUPPER);
10228   UFWORDX("LOWER", STRLOWER);
10229   UFWORDX("(CHAR-DIGIT)", CHAR_DIGIT);
10230   UFWORDX("DIGIT", DIGIT);
10231   UFWORDX("DIGIT?", DIGITQ);
10232
10233   UFWORDX("IS-DIGIT", IS_DIGIT);
10234   UFWORDX("IS-BIN-DIGIT", IS_BIN_DIGIT);
10235   UFWORDX("IS-OCT-DIGIT", IS_OCT_DIGIT);
10236   UFWORDX("IS-HEX-DIGIT", IS_HEX_DIGIT);
10237   UFWORDX("IS-ALPHA", IS_ALPHA);
10238   UFWORDX("IS-UNDER-DOT", IS_UNDER_DOT);
10239   UFWORDX("IS-ALNUM", IS_ALNUM);
10240   UFWORDX("IS-ID-START", IS_ID_START);
10241   UFWORDX("IS-ID-CHAR", IS_ID_CHAR);
10242
10243   ufoVocSetOnlyDefs(ufoForthVocId);
10244 }
10245
10246
10247 //==========================================================================
10248 //
10249 //  ufoInitDebugWords
10250 //
10251 //==========================================================================
10252 UFO_DISABLE_INLINE void ufoInitDebugWords (void) {
10253   // create "DEBUG" vocabulary
10254   const uint32_t debugVocId = ufoCreateVoc("DEBUG", 0, UFW_FLAG_PROTECTED);
10255   ufoVocSetOnlyDefs(debugVocId);
10256   UFWORDX("(DECOMPILE-CFA)", DEBUG_DECOMPILE_CFA);
10257   UFWORDX("(DECOMPILE-MEM)", DEBUG_DECOMPILE_MEM);
10258   UFWORDX("BACKTRACE", UFO_BACKTRACE);
10259   UFWORDX("DUMP-STACK", DUMP_STACK);
10260   #ifdef UFO_MTASK_ALLOWED
10261   UFWORDX("BACKTRACE-TASK", UFO_BACKTRACE_TASK);
10262   UFWORDX("DUMP-STACK-TASK", DUMP_STACK_TASK);
10263   UFWORDX("DUMP-RSTACK-TASK", DUMP_RSTACK_TASK);
10264   #endif
10265   UFWORDX("(BP)", MT_DEBUGGER_BP);
10266   UFWORDX("IP->NFA", IP2NFA);
10267   UFWORDX("IP->FILE/LINE", IP2FILELINE);
10268   UFWORDX("IP->FILE-HASH/LINE", IP2FILEHASHLINE);
10269   #ifdef UFO_MTASK_ALLOWED
10270   UFWORDX("SINGLE-STEP@", DBG_GET_SS);
10271   #endif
10272   ufoVocSetOnlyDefs(ufoForthVocId);
10273 }
10274
10275
10276 //==========================================================================
10277 //
10278 //  ufoInitMTWords
10279 //
10280 //==========================================================================
10281 UFO_DISABLE_INLINE void ufoInitMTWords (void) {
10282   // create "MTASK" vocabulary
10283   const uint32_t mtVocId = ufoCreateVoc("MTASK", 0, UFW_FLAG_PROTECTED);
10284   ufoVocSetOnlyDefs(mtVocId);
10285   #ifdef UFO_MTASK_ALLOWED
10286   UFWORDX("NEW-STATE", MT_NEW_STATE);
10287   UFWORDX("FREE-STATE", MT_FREE_STATE);
10288   #endif
10289   UFWORDX("STATE-NAME@", MT_GET_STATE_NAME);
10290   UFWORDX("STATE-NAME!", MT_SET_STATE_NAME);
10291   #ifdef UFO_MTASK_ALLOWED
10292   UFWORDX("STATE-FIRST", MT_STATE_FIRST);
10293   UFWORDX("STATE-NEXT", MT_STATE_NEXT);
10294   UFWORDX("YIELD-TO", MT_YIELD_TO);
10295   UFWORDX("SET-SELF-AS-DEBUGGER", MT_SET_SELF_AS_DEBUGGER);
10296   UFWORDX("DEBUGGER-RESUME", MT_RESUME_DEBUGEE);
10297   UFWORDX("DEBUGGER-SINGLE-STEP", MT_SINGLE_STEP_DEBUGEE);
10298   #endif
10299   UFWORDX("ACTIVE-STATE", MT_ACTIVE_STATE);
10300   UFWORDX("STATE-IP@", MT_STATE_IP_GET);
10301   UFWORDX("STATE-IP!", MT_STATE_IP_SET);
10302   UFWORDX("STATE-A>", MT_STATE_REGA_GET);
10303   UFWORDX("STATE->A", MT_STATE_REGA_SET);
10304   UFWORDX("STATE-USER@", MT_STATE_USER_GET);
10305   UFWORDX("STATE-USER!", MT_STATE_USER_SET);
10306   UFWORDX("YIELDED-FROM", MT_YIELDED_FROM);
10307   UFWORDX("STATE-SP@", MT_DSTACK_DEPTH_GET);
10308   UFWORDX("STATE-RP@", MT_RSTACK_DEPTH_GET);
10309   UFWORDX("STATE-LP@", MT_LP_GET);
10310   UFWORDX("STATE-LBP@", MT_LBP_GET);
10311   UFWORDX("STATE-SP!", MT_DSTACK_DEPTH_SET);
10312   UFWORDX("STATE-RP!", MT_RSTACK_DEPTH_SET);
10313   UFWORDX("STATE-LP!", MT_LP_SET);
10314   UFWORDX("STATE-LBP!", MT_LBP_SET);
10315   UFWORDX("STATE-DS@", MT_DSTACK_LOAD);
10316   UFWORDX("STATE-RS@", MT_RSTACK_LOAD);
10317   UFWORDX("STATE-LS@", MT_LSTACK_LOAD);
10318   UFWORDX("STATE-DS!", MT_DSTACK_STORE);
10319   UFWORDX("STATE-RS!", MT_RSTACK_STORE);
10320   UFWORDX("STATE-LS!", MT_LSTACK_STORE);
10321   UFWORDX("STATE-VSP@", MT_VSP_GET);
10322   UFWORDX("STATE-VSP!", MT_VSP_SET);
10323   UFWORDX("STATE-VSP-AT@", MT_VSP_LOAD);
10324   UFWORDX("STATE-VSP-AT!", MT_VSP_STORE);
10325   ufoVocSetOnlyDefs(ufoForthVocId);
10326 }
10327
10328
10329 //==========================================================================
10330 //
10331 //  ufoInitTTYWords
10332 //
10333 //==========================================================================
10334 UFO_DISABLE_INLINE void ufoInitTTYWords (void) {
10335   // create "TTY" vocabulary
10336   const uint32_t ttyVocId = ufoCreateVoc("TTY", 0, UFW_FLAG_PROTECTED);
10337   ufoVocSetOnlyDefs(ttyVocId);
10338   UFWORDX("TTY?", TTY_TTYQ);
10339   UFWORDX("RAW?", TTY_RAWQ);
10340   UFWORDX("SIZE", TTY_SIZE);
10341   UFWORDX("SET-RAW", TTY_SET_RAW);
10342   UFWORDX("SET-COOKED", TTY_SET_COOKED);
10343   UFWORDX("RAW-EMIT", TTY_RAW_EMIT);
10344   UFWORDX("RAW-TYPE", TTY_RAW_TYPE);
10345   UFWORDX("RAW-FLUSH", TTY_RAW_FLUSH);
10346   UFWORDX("RAW-READCH", TTY_RAW_READCH);
10347   UFWORDX("RAW-READY?", TTY_RAW_READYQ);
10348   ufoVocSetOnlyDefs(ufoForthVocId);
10349 }
10350
10351
10352 //==========================================================================
10353 //
10354 //  ufoInitFilesWords
10355 //
10356 //==========================================================================
10357 UFO_DISABLE_INLINE void ufoInitFilesWords (void) {
10358   // create "FILES" vocabulary
10359   const uint32_t filesVocId = ufoCreateVoc("FILES", 0, UFW_FLAG_PROTECTED);
10360   ufoVocSetOnlyDefs(filesVocId);
10361   ufoDefineConstant("SEEK-SET", SEEK_SET);
10362   ufoDefineConstant("SEEK-CUR", SEEK_CUR);
10363   ufoDefineConstant("SEEK-END", SEEK_END);
10364
10365   UFWORDX("OPEN-R/O", FILES_OPEN_RO);
10366   UFWORDX("OPEN-R/W", FILES_OPEN_RW);
10367   UFWORDX("CREATE", FILES_CREATE);
10368   UFWORDX("CLOSE", FILES_CLOSE);
10369   UFWORDX("TELL", FILES_TELL);
10370   UFWORDX("SEEK-EX", FILES_SEEK_EX);
10371   UFWORDX("SIZE", FILES_SIZE);
10372   UFWORDX("READ", FILES_READ);
10373   UFWORDX("READ-EXACT", FILES_READ_EXACT);
10374   UFWORDX("WRITE", FILES_WRITE);
10375
10376   UFWORDX("UNLINK", FILES_UNLINK);
10377
10378   UFWORDX("ERRNO", FILES_ERRNO);
10379
10380   ufoInterpretLine(
10381     ": SEEK  ( ofs handle -- success? ) "
10382     "  SEEK-SET FORTH:SWAP SEEK-EX "
10383     ";");
10384
10385   ufoVocSetOnlyDefs(ufoForthVocId);
10386 }
10387
10388
10389 //==========================================================================
10390 //
10391 //  ufoInitVeryVeryHighWords
10392 //
10393 //==========================================================================
10394 UFO_DISABLE_INLINE void ufoInitVeryVeryHighWords (void) {
10395   // interpret defer
10396   //ufoDefineDefer("INTERPRET", idumbCFA);
10397
10398   ufoDefineEmitType();
10399
10400   // ( addr count FALSE -- addr count FALSE / TRUE )
10401   ufoDefineSColonForth("(INTERPRET-CHECK-WORD)");
10402   ufoDoneForth();
10403   // ( addr count FALSE -- addr count FALSE / TRUE )
10404   ufoDefineSColonForth("(INTERPRET-WORD-NOT-FOUND)");
10405   ufoDoneForth();
10406   // ( addr count -- addr count )
10407   ufoDefineSColonForth("(INTERPRET-WORD-NOT-FOUND-POST)");
10408   ufoDoneForth();
10409   // ( -- ) -- called in "EXIT", before compiling "FORTH:(EXIT)"
10410   ufoDefineSColonForth("(EXIT-EXTENDER)");
10411   ufoDoneForth();
10412
10413   // EXIT  ( -- )
10414   ufoInterpretLine(
10415     "!: EXIT  ( -- ) "
10416     " COMPILER:?COMP (EXIT-EXTENDER) "
10417     //" HERE >R "
10418     " COMPILE FORTH:(EXIT) "
10419     //" R> COMPILER:(AFTER-COMPILE-WORD) "
10420     ";");
10421
10422   ufoDefineInterpret();
10423
10424   //ufoDumpVocab(ufoCompilerVocId);
10425
10426   ufoInterpretLine(
10427     ": RUN-INTERPRET-LOOP "
10428     "$run-interp-loop-again: "
10429     "  RP0! INTERPRET (UFO-INTERPRET-FINISHED-ACTION) "
10430     "  FORTH:(BRANCH) $run-interp-loop-again "
10431     ";"); ufoSetLatestFlags(UFW_FLAG_NORETURN);
10432 }
10433
10434 #define UFO_ADD_DO_CFA(cfx_)  do { \
10435   ufoDo##cfx_##CFA = ufoCFAsUsed | UFO_ADDR_CFA_BIT; \
10436   ufoForthCFAs[ufoCFAsUsed] = &ufoDo##cfx_; \
10437   ufoCFAsUsed += 1; \
10438 } while (0)
10439
10440
10441 //==========================================================================
10442 //
10443 //  ufoBadCFA
10444 //
10445 //==========================================================================
10446 static void ufoBadCFA (uint32_t pfa) {
10447   ufoFatal("tried to execute an invalid CFA: IP=%u", ufoIP - 4u);
10448 }
10449
10450
10451 //==========================================================================
10452 //
10453 //  ufoInitCommon
10454 //
10455 //==========================================================================
10456 UFO_DISABLE_INLINE void ufoInitCommon (void) {
10457   ufoVSP = 0;
10458   ufoForthVocId = 0; ufoCompilerVocId = 0;
10459
10460   //ufoForthCFAs = calloc(UFO_MAX_NATIVE_CFAS, sizeof(ufoForthCFAs[0]));
10461   for (uint32_t f = 0; f < UFO_MAX_NATIVE_CFAS; f += 1) ufoForthCFAs[f] = &ufoBadCFA;
10462
10463   // allocate default TIB handle
10464   //UfoHandle *tibh = ufoAllocHandle(0x69a029a6); // arbitrary number
10465   //ufoDefTIB = tibh->ufoHandle;
10466
10467   /*ufoForthCFAs[0] = NULL;*/ ufoCFAsUsed = 1u;
10468   UFO_ADD_DO_CFA(Forth);
10469   UFO_ADD_DO_CFA(Variable);
10470   UFO_ADD_DO_CFA(Value);
10471   UFO_ADD_DO_CFA(Const);
10472   UFO_ADD_DO_CFA(Defer);
10473   UFO_ADD_DO_CFA(Does);
10474   UFO_ADD_DO_CFA(Redirect);
10475   UFO_ADD_DO_CFA(Voc);
10476   UFO_ADD_DO_CFA(Create);
10477   UFO_ADD_DO_CFA(UserVariable);
10478
10479   //fprintf(stderr, "DO-FORTH-CFA: 0x%08x\n", ufoDoForthCFA);
10480
10481   ufoInitBaseDict();
10482
10483   // create "FORTH" vocabulary (it should be the first one)
10484   ufoForthVocId = ufoCreateVoc("FORTH", 0, UFW_FLAG_PROTECTED);
10485   ufoVocSetOnlyDefs(ufoForthVocId);
10486
10487   // base low-level interpreter words
10488   ufoInitBasicWords();
10489
10490   // more FORTH words
10491   ufoInitMoreWords();
10492
10493   // some COMPILER words
10494   ufoInitBasicCompilerWords();
10495
10496   // STRING vocabulary
10497   ufoInitStringWords();
10498
10499   // DEBUG vocabulary
10500   ufoInitDebugWords();
10501
10502   // MTASK vocabulary
10503   ufoInitMTWords();
10504
10505   // HANDLE vocabulary
10506   ufoInitHandleWords();
10507
10508   // TTY vocabulary
10509   ufoInitTTYWords();
10510
10511   // FILES vocabulary
10512   ufoInitFilesWords();
10513
10514   // some higher-level FORTH words (includes, etc.)
10515   ufoInitHigherWords();
10516
10517   // very-very high-level FORTH words
10518   ufoInitVeryVeryHighWords();
10519
10520   ufoFinalLabelCheck();
10521
10522   #if 0
10523   ufoDecompileWord(ufoFindWordChecked("RUN-INTERPRET-LOOP"));
10524   #endif
10525
10526   ufoReset();
10527 }
10528
10529 #undef UFC
10530
10531
10532 // ////////////////////////////////////////////////////////////////////////// //
10533 // virtual machine executor
10534 //
10535
10536
10537 //==========================================================================
10538 //
10539 //  ufoRunVMxxx
10540 //
10541 //  address interpreter
10542 //
10543 //==========================================================================
10544 static void ufoRunVMxxx (uint32_t cfa) {
10545   UFO_EXEC_CFA(cfa);
10546   // VM execution loop
10547   for (;;) {
10548     cfa = ufoImgGetU32(ufoIP); ufoIP += 4u;
10549     UFO_EXEC_CFA(cfa);
10550   }
10551 }
10552
10553
10554 //==========================================================================
10555 //
10556 //  ufoRunVMCFA
10557 //
10558 //==========================================================================
10559 static void ufoRunVMCFA (uint32_t cfa) {
10560   if (ufoInRunWord) ufoFatal("cannot run VM recursively");
10561   ufoInRunWord = 1;
10562   if (setjmp(ufoStopVMJP) == 0) {
10563     ufoRunVMxxx(cfa);
10564   }
10565   ufoInRunWord = 0;
10566 }
10567
10568
10569 // ////////////////////////////////////////////////////////////////////////// //
10570 // high-level API
10571 //
10572
10573 //==========================================================================
10574 //
10575 //  ufoRegisterWord
10576 //
10577 //  register new word
10578 //
10579 //==========================================================================
10580 uint32_t ufoRegisterWord (const char *wname, ufoNativeCFA cfa, uint32_t flags) {
10581   ufo_assert(cfa != NULL);
10582   ufo_assert(wname != NULL && wname[0] != 0);
10583   uint32_t cfaidx = ufoCFAsUsed;
10584   if (cfaidx >= UFO_MAX_NATIVE_CFAS) ufoFatal("too many native words");
10585   ufoForthCFAs[cfaidx] = cfa;
10586   ufoCFAsUsed += 1;
10587   //ufoDefineNative(wname, xcfa, 0);
10588   cfaidx |= UFO_ADDR_CFA_BIT;
10589   flags &= 0xffffff00u;
10590   ufoCreateWordHeader(wname, flags);
10591   const uint32_t res = UFO_GET_DP();
10592   ufoImgEmitCFA(cfaidx);
10593   return res;
10594 }
10595
10596
10597 //==========================================================================
10598 //
10599 //  ufoRegisterDataWord
10600 //
10601 //==========================================================================
10602 static uint32_t ufoRegisterDataWord (const char *wname, uint32_t cfaidx, uint32_t value,
10603                                      uint32_t flags)
10604 {
10605   ufo_assert(wname != NULL && wname[0] != 0);
10606   flags &= 0xffffff00u;
10607   ufoCreateWordHeader(wname, flags);
10608   ufoImgEmitCFA(cfaidx);
10609   const uint32_t res = UFO_GET_DP();
10610   ufoImgEmitU32(value);
10611   return res;
10612 }
10613
10614
10615 //==========================================================================
10616 //
10617 //  ufoRegisterConstant
10618 //
10619 //==========================================================================
10620 void ufoRegisterConstant (const char *wname, uint32_t value, uint32_t flags) {
10621   (void)ufoRegisterDataWord(wname, ufoDoConstCFA, value, flags);
10622 }
10623
10624
10625 //==========================================================================
10626 //
10627 //  ufoRegisterVariable
10628 //
10629 //==========================================================================
10630 uint32_t ufoRegisterVariable (const char *wname, uint32_t value, uint32_t flags) {
10631   return ufoRegisterDataWord(wname, ufoDoVariableCFA, value, flags);
10632 }
10633
10634
10635 //==========================================================================
10636 //
10637 //  ufoRegisterValue
10638 //
10639 //==========================================================================
10640 uint32_t ufoRegisterValue (const char *wname, uint32_t value, uint32_t flags) {
10641   return ufoRegisterDataWord(wname, ufoDoValueCFA, value, flags);
10642 }
10643
10644
10645 //==========================================================================
10646 //
10647 //  ufoRegisterDefer
10648 //
10649 //==========================================================================
10650 uint32_t ufoRegisterDefer (const char *wname, uint32_t value, uint32_t flags) {
10651   return ufoRegisterDataWord(wname, ufoDoDeferCFA, value, flags);
10652 }
10653
10654
10655 //==========================================================================
10656 //
10657 //  ufoFindWordInVocabulary
10658 //
10659 //  check if we have the corresponding word.
10660 //  return CFA suitable for executing, or 0.
10661 //
10662 //==========================================================================
10663 uint32_t ufoFindWordInVocabulary (const char *wname, uint32_t vocid) {
10664   if (wname == NULL || wname[0] == 0) return 0;
10665   size_t wlen = strlen(wname);
10666   if (wlen >= UFO_MAX_WORD_LENGTH) return 0;
10667   return ufoFindWordInVocAndParents(wname, (uint32_t)wlen, 0, vocid, 0);
10668 }
10669
10670
10671 //==========================================================================
10672 //
10673 //  ufoGetIP
10674 //
10675 //==========================================================================
10676 uint32_t ufoGetIP (void) {
10677   return ufoIP;
10678 }
10679
10680
10681 //==========================================================================
10682 //
10683 //  ufoSetIP
10684 //
10685 //==========================================================================
10686 void ufoSetIP (uint32_t newip) {
10687   ufoIP = newip;
10688 }
10689
10690
10691 //==========================================================================
10692 //
10693 //  ufoIsExecuting
10694 //
10695 //==========================================================================
10696 int ufoIsExecuting (void) {
10697   return (ufoImgGetU32(ufoAddrSTATE) == 0);
10698 }
10699
10700
10701 //==========================================================================
10702 //
10703 //  ufoIsCompiling
10704 //
10705 //==========================================================================
10706 int ufoIsCompiling (void) {
10707   return (ufoImgGetU32(ufoAddrSTATE) != 0);
10708 }
10709
10710
10711 //==========================================================================
10712 //
10713 //  ufoSetExecuting
10714 //
10715 //==========================================================================
10716 void ufoSetExecuting (void) {
10717   ufoImgPutU32(ufoAddrSTATE, 0);
10718 }
10719
10720
10721 //==========================================================================
10722 //
10723 //  ufoSetCompiling
10724 //
10725 //==========================================================================
10726 void ufoSetCompiling (void) {
10727   ufoImgPutU32(ufoAddrSTATE, 1);
10728 }
10729
10730
10731 //==========================================================================
10732 //
10733 //  ufoGetHere
10734 //
10735 //==========================================================================
10736 uint32_t ufoGetHere () {
10737   return UFO_GET_DP();
10738 }
10739
10740
10741 //==========================================================================
10742 //
10743 //  ufoGetPad
10744 //
10745 //==========================================================================
10746 uint32_t ufoGetPad () {
10747   return UFO_PAD_ADDR;
10748 }
10749
10750
10751 //==========================================================================
10752 //
10753 //  ufoTIBPeekCh
10754 //
10755 //==========================================================================
10756 uint8_t ufoTIBPeekCh (uint32_t ofs) {
10757   return ufoTibPeekChOfs(ofs);
10758 }
10759
10760
10761 //==========================================================================
10762 //
10763 //  ufoTIBGetCh
10764 //
10765 //==========================================================================
10766 uint8_t ufoTIBGetCh (void) {
10767   return ufoTibGetCh();
10768 }
10769
10770
10771 //==========================================================================
10772 //
10773 //  ufoTIBSkipCh
10774 //
10775 //==========================================================================
10776 void ufoTIBSkipCh (void) {
10777   ufoTibSkipCh();
10778 }
10779
10780
10781 //==========================================================================
10782 //
10783 //  ufoTIBSRefill
10784 //
10785 //  returns 0 on EOF
10786 //
10787 //==========================================================================
10788 int ufoTIBSRefill (int allowCrossIncludes) {
10789   return ufoLoadNextLine(allowCrossIncludes);
10790 }
10791
10792
10793 //==========================================================================
10794 //
10795 //  ufoPeekData
10796 //
10797 //==========================================================================
10798 uint32_t ufoPeekData (void) {
10799   return ufoPeek();
10800 }
10801
10802
10803 //==========================================================================
10804 //
10805 //  ufoPopData
10806 //
10807 //==========================================================================
10808 uint32_t ufoPopData (void) {
10809   return ufoPop();
10810 }
10811
10812
10813 //==========================================================================
10814 //
10815 //  ufoPushData
10816 //
10817 //==========================================================================
10818 void ufoPushData (uint32_t value) {
10819   return ufoPush(value);
10820 }
10821
10822
10823 //==========================================================================
10824 //
10825 //  ufoPushBoolData
10826 //
10827 //==========================================================================
10828 void ufoPushBoolData (int val) {
10829   ufoPushBool(val);
10830 }
10831
10832
10833 //==========================================================================
10834 //
10835 //  ufoPeekRet
10836 //
10837 //==========================================================================
10838 uint32_t ufoPeekRet (void) {
10839   return ufoRPeek();
10840 }
10841
10842
10843 //==========================================================================
10844 //
10845 //  ufoPopRet
10846 //
10847 //==========================================================================
10848 uint32_t ufoPopRet (void) {
10849   return ufoRPop();
10850 }
10851
10852
10853 //==========================================================================
10854 //
10855 //  ufoPushRet
10856 //
10857 //==========================================================================
10858 void ufoPushRet (uint32_t value) {
10859   return ufoRPush(value);
10860 }
10861
10862
10863 //==========================================================================
10864 //
10865 //  ufoPushBoolRet
10866 //
10867 //==========================================================================
10868 void ufoPushBoolRet (int val) {
10869   ufoRPush(val ? ufoTrueValue : 0);
10870 }
10871
10872
10873 //==========================================================================
10874 //
10875 //  ufoPeekByte
10876 //
10877 //==========================================================================
10878 uint8_t ufoPeekByte (uint32_t addr) {
10879   return ufoImgGetU8(addr);
10880 }
10881
10882
10883 //==========================================================================
10884 //
10885 //  ufoPeekWord
10886 //
10887 //==========================================================================
10888 uint16_t ufoPeekWord (uint32_t addr) {
10889   ufoPush(addr);
10890   UFCALL(WPEEK);
10891   return ufoPop();
10892 }
10893
10894
10895 //==========================================================================
10896 //
10897 //  ufoPeekCell
10898 //
10899 //==========================================================================
10900 uint32_t ufoPeekCell (uint32_t addr) {
10901   ufoPush(addr);
10902   UFCALL(PEEK);
10903   return ufoPop();
10904 }
10905
10906
10907 //==========================================================================
10908 //
10909 //  ufoPokeByte
10910 //
10911 //==========================================================================
10912 void ufoPokeByte (uint32_t addr, uint32_t value) {
10913   ufoImgPutU8(addr, value);
10914 }
10915
10916
10917 //==========================================================================
10918 //
10919 //  ufoPokeWord
10920 //
10921 //==========================================================================
10922 void ufoPokeWord (uint32_t addr, uint32_t value) {
10923   ufoPush(value);
10924   ufoPush(addr);
10925   UFCALL(WPOKE);
10926 }
10927
10928
10929 //==========================================================================
10930 //
10931 //  ufoPokeCell
10932 //
10933 //==========================================================================
10934 void ufoPokeCell (uint32_t addr, uint32_t value) {
10935   ufoPush(value);
10936   ufoPush(addr);
10937   UFCALL(POKE);
10938 }
10939
10940
10941 //==========================================================================
10942 //
10943 //  ufoGetPAD
10944 //
10945 //==========================================================================
10946 uint32_t ufoGetPAD (void) {
10947   return UFO_PAD_ADDR;
10948 }
10949
10950
10951 //==========================================================================
10952 //
10953 //  ufoEmitByte
10954 //
10955 //==========================================================================
10956 void ufoEmitByte (uint32_t value) {
10957   ufoImgEmitU8(value);
10958 }
10959
10960
10961 //==========================================================================
10962 //
10963 //  ufoEmitWord
10964 //
10965 //==========================================================================
10966 void ufoEmitWord (uint32_t value) {
10967   ufoImgEmitU8(value & 0xff);
10968   ufoImgEmitU8((value >> 8) & 0xff);
10969 }
10970
10971
10972 //==========================================================================
10973 //
10974 //  ufoEmitCell
10975 //
10976 //==========================================================================
10977 void ufoEmitCell (uint32_t value) {
10978   ufoImgEmitU32(value);
10979 }
10980
10981
10982 //==========================================================================
10983 //
10984 //  ufoIsInited
10985 //
10986 //==========================================================================
10987 int ufoIsInited (void) {
10988   return (ufoMode != UFO_MODE_NONE);
10989 }
10990
10991
10992 //==========================================================================
10993 //
10994 //  ufoSetUserAbort
10995 //
10996 //==========================================================================
10997 void ufoSetUserAbort (void) {
10998   //ufoVMAbort = 1;
10999   //HACK: push "(USER-ABORT)" word to RP
11000   ufoRPush(ufoUserAbortCFA);
11001 }
11002
11003
11004 static void (*ufoUserPostInitCB) (void);
11005
11006
11007 //==========================================================================
11008 //
11009 //  ufoSetUserPostInit
11010 //
11011 //  called after main initialisation
11012 //
11013 //==========================================================================
11014 void ufoSetUserPostInit (void (*cb) (void)) {
11015   ufoUserPostInitCB = cb;
11016 }
11017
11018
11019 //==========================================================================
11020 //
11021 //  ufoSStepAllowed
11022 //
11023 //==========================================================================
11024 int ufoSStepAllowed (void) {
11025   #ifdef UFO_MTASK_ALLOWED
11026   return (ufoSingleStepAllowed != 0);
11027   #else
11028   return 0;
11029   #endif
11030 }
11031
11032
11033 //==========================================================================
11034 //
11035 //  ufoSetSStepAllowed
11036 //
11037 //==========================================================================
11038 void ufoSetSStepAllowed (int enabled) {
11039   #ifdef UFO_MTASK_ALLOWED
11040   ufoSingleStepAllowed = (enabled ? 1 : 0);
11041   #else
11042   (void)enabled;
11043   #endif
11044 }
11045
11046
11047 //==========================================================================
11048 //
11049 //  ufoInit
11050 //
11051 //==========================================================================
11052 void ufoInit (void) {
11053   if (ufoMode != UFO_MODE_NONE) return;
11054   ufoMode = UFO_MODE_NATIVE;
11055
11056   #ifdef UFO_HUGE_IMAGES
11057   memset(ufoImage, 0, sizeof(ufoImage));
11058   #endif
11059
11060   #ifdef UFO_MTASK_ALLOWED
11061   ufoSingleStepAllowed = 0;
11062   #endif
11063
11064   ufoInFileLine = 0;
11065   ufoInFileName = NULL; ufoInFileNameLen = 0; ufoInFileNameHash = 0;
11066   ufoInFile = NULL;
11067   ufoLastIncPath = NULL; ufoLastSysIncPath = NULL;
11068
11069   #ifdef UFO_MTASK_ALLOWED
11070   for (uint32_t f = 0; f < UFO_MAX_STATES; f += 1u) ufoStateMap[f] = NULL;
11071   memset(ufoStateUsedBitmap, 0, sizeof(ufoStateUsedBitmap));
11072   ufoCurrState = ufoNewState();
11073   strcpy(ufoCurrState->name, "MAIN");
11074   ufoInitStateUserVars(ufoCurrState);
11075   #else
11076   memset(&ufoCurrState, 0, sizeof(ufoCurrState));
11077   strcpy(ufoCurrState.name, "MAIN");
11078   ufoInitStateUserVars(&ufoCurrState);
11079   #endif
11080
11081   ufoImgPutU32(ufoAddrDefTIB, 0); // create TIB handle
11082   ufoImgPutU32(ufoAddrTIBx, 0); // create TIB handle
11083
11084   #ifdef UFO_MTASK_ALLOWED
11085   ufoYieldedState = NULL;
11086   ufoDebuggerState = NULL;
11087   ufoSingleStep = 0;
11088   #endif
11089
11090   #ifdef UFO_DEBUG_STARTUP_TIMES
11091   uint32_t stt = ufo_get_msecs();
11092   ufoCondDefine("UFO-DEBUG-STARTUP-TIMES");
11093   #endif
11094   ufoInitCommon();
11095   #ifdef UFO_DEBUG_STARTUP_TIMES
11096   uint32_t ett = ufo_get_msecs();
11097   fprintf(stderr, "UrForth init time: %u msecs\n", (unsigned)(ett - stt));
11098   #endif
11099
11100   ufoReset();
11101
11102   if (ufoUserPostInitCB) {
11103     ufoUserPostInitCB();
11104     ufoReset();
11105   }
11106
11107   // load ufo modules
11108   char *ufmname = ufoCreateIncludeName("init", 1, NULL);
11109   #ifdef WIN32
11110   FILE *ufl = fopen(ufmname, "rb");
11111   #else
11112   FILE *ufl = fopen(ufmname, "r");
11113   #endif
11114   if (ufl) {
11115     ufoPushInFile();
11116     ufoSetInFileNameReuse(ufmname);
11117     ufoInFile = ufl;
11118     ufoFileId = ufoLastUsedFileId;
11119     setLastIncPath(ufoInFileName, 1);
11120   } else {
11121     free(ufmname);
11122     ufoFatal("cannot load init code");
11123   }
11124
11125   if (ufoInFile != NULL) {
11126     ufoRunInterpretLoop();
11127   }
11128 }
11129
11130
11131 //==========================================================================
11132 //
11133 //  ufoFinishVM
11134 //
11135 //==========================================================================
11136 void ufoFinishVM (void) {
11137   if (ufoInRunWord) {
11138     longjmp(ufoStopVMJP, 669);
11139   } else {
11140     ufoFatal("VM is not running");
11141   }
11142 }
11143
11144
11145 //==========================================================================
11146 //
11147 //  ufoCallParseIntr
11148 //
11149 //  ( -- addr count TRUE / FALSE )
11150 //  does base TIB parsing; never copies anything.
11151 //  as our reader is line-based, returns FALSE on EOL.
11152 //  EOL is detected after skipping leading delimiters.
11153 //  passing -1 as delimiter skips the whole line, and always returns FALSE.
11154 //  trailing delimiter is always skipped.
11155 //  result is on the data stack.
11156 //
11157 //==========================================================================
11158 void ufoCallParseIntr (uint32_t delim, int skipLeading) {
11159   ufoPush(delim); ufoPushBool(skipLeading);
11160   UFCALL(PAR_PARSE);
11161 }
11162
11163
11164 //==========================================================================
11165 //
11166 //  ufoCallParseName
11167 //
11168 //  ( -- addr count )
11169 //  parse with leading blanks skipping. doesn't copy anything.
11170 //  return empty string on EOL.
11171 //
11172 //==========================================================================
11173 void ufoCallParseName (void) {
11174   UFCALL(PARSE_NAME);
11175 }
11176
11177
11178 //==========================================================================
11179 //
11180 //  ufoCallParse
11181 //
11182 //  ( -- addr count TRUE / FALSE )
11183 //  parse without skipping delimiters; never copies anything.
11184 //  as our reader is line-based, returns FALSE on EOL.
11185 //  passing 0 as delimiter skips the whole line, and always returns FALSE.
11186 //  trailing delimiter is always skipped.
11187 //
11188 //==========================================================================
11189 void ufoCallParse (uint32_t delim) {
11190   ufoPush(delim);
11191   UFCALL(PARSE);
11192 }
11193
11194
11195 //==========================================================================
11196 //
11197 //  ufoCallParseSkipBlanks
11198 //
11199 //==========================================================================
11200 void ufoCallParseSkipBlanks (void) {
11201   UFCALL(PARSE_SKIP_BLANKS);
11202 }
11203
11204
11205 //==========================================================================
11206 //
11207 //  ufoCallParseSkipComments
11208 //
11209 //==========================================================================
11210 void ufoCallParseSkipComments (void) {
11211   ufoPushBool(1); UFCALL(PAR_PARSE_SKIP_COMMENTS);
11212 }
11213
11214
11215 //==========================================================================
11216 //
11217 //  ufoCallParseSkipLineComments
11218 //
11219 //==========================================================================
11220 void ufoCallParseSkipLineComments (void) {
11221   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
11222 }
11223
11224
11225 //==========================================================================
11226 //
11227 //  ufoCallParseSkipLine
11228 //
11229 //  to the end of line; doesn't refill
11230 //
11231 //==========================================================================
11232 void ufoCallParseSkipLine (void) {
11233   UFCALL(PARSE_SKIP_LINE);
11234 }
11235
11236
11237 //==========================================================================
11238 //
11239 //  ufoCallBasedNumber
11240 //
11241 //  convert number from addrl+1
11242 //  returns address of the first inconvertible char
11243 //  (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
11244 //
11245 //==========================================================================
11246 void ufoCallBasedNumber (uint32_t addr, uint32_t count, int allowSign, int base) {
11247   ufoPush(addr); ufoPush(count); ufoPushBool(allowSign);
11248   if (base < 0) ufoPush(0); else ufoPush((uint32_t)base);
11249   UFCALL(PAR_BASED_NUMBER);
11250 }
11251
11252
11253 //==========================================================================
11254 //
11255 //  ufoRunWord
11256 //
11257 //==========================================================================
11258 void ufoRunWord (uint32_t cfa) {
11259   if (cfa != 0) {
11260     if (ufoMode == UFO_MODE_NONE) ufoFatal("UrForth is not properly inited");
11261     if (ufoInRunWord) ufoFatal("`ufoRunWord` cannot be called recursively");
11262     ufoMode = UFO_MODE_NATIVE;
11263     ufoRunVMCFA(cfa);
11264   }
11265 }
11266
11267
11268 //==========================================================================
11269 //
11270 //  ufoRunMacroWord
11271 //
11272 //==========================================================================
11273 void ufoRunMacroWord (uint32_t cfa) {
11274   if (cfa != 0) {
11275     if (ufoMode == UFO_MODE_NONE) ufoFatal("UrForth is not properly inited");
11276     if (ufoInRunWord) ufoFatal("`ufoRunWord` cannot be called recursively");
11277     ufoMode = UFO_MODE_MACRO;
11278     const uint32_t oisp = ufoFileStackPos;
11279     ufoPushInFile();
11280     ufoFileId = 0;
11281     (void)ufoLoadNextUserLine();
11282     ufoRunVMCFA(cfa);
11283     ufoPopInFile();
11284     ufo_assert(ufoFileStackPos == oisp); // sanity check
11285   }
11286 }
11287
11288
11289 //==========================================================================
11290 //
11291 //  ufoIsInMacroMode
11292 //
11293 //  check if we are currently in "MACRO" mode.
11294 //  should be called from registered words.
11295 //
11296 //==========================================================================
11297 int ufoIsInMacroMode (void) {
11298   return (ufoMode == UFO_MODE_MACRO);
11299 }
11300
11301
11302 //==========================================================================
11303 //
11304 //  ufoRunInterpretLoop
11305 //
11306 //  run default interpret loop.
11307 //
11308 //==========================================================================
11309 void ufoRunInterpretLoop (void) {
11310   if (ufoMode == UFO_MODE_NONE) {
11311     ufoInit();
11312   }
11313   const uint32_t cfa = ufoFindWord("RUN-INTERPRET-LOOP");
11314   if (cfa == 0) ufoFatal("'RUN-INTERPRET-LOOP' word not found");
11315   ufoReset();
11316   ufoMode = UFO_MODE_NATIVE;
11317   ufoRunVMCFA(cfa);
11318   while (ufoFileStackPos != 0) ufoPopInFile();
11319 }
11320
11321
11322 //==========================================================================
11323 //
11324 //  ufoRunFile
11325 //
11326 //==========================================================================
11327 void ufoRunFile (const char *fname) {
11328   if (ufoMode == UFO_MODE_NONE) {
11329     ufoInit();
11330   }
11331   if (ufoInRunWord) ufoFatal("`ufoRunFile` cannot be called recursively");
11332   ufoMode = UFO_MODE_NATIVE;
11333
11334   ufoReset();
11335   char *ufmname = ufoCreateIncludeName(fname, 0, ".");
11336   #ifdef WIN32
11337   FILE *ufl = fopen(ufmname, "rb");
11338   #else
11339   FILE *ufl = fopen(ufmname, "r");
11340   #endif
11341   if (ufl) {
11342     ufoPushInFile();
11343     ufoSetInFileNameReuse(ufmname);
11344     ufoInFile = ufl;
11345     ufoFileId = ufoLastUsedFileId;
11346     setLastIncPath(ufoInFileName, 0);
11347   } else {
11348     free(ufmname);
11349     ufoFatal("cannot load source file '%s'", fname);
11350   }
11351   ufoRunInterpretLoop();
11352 }
11353
11354
11355 //==========================================================================
11356 //
11357 //  ufoIsMTaskEnabled
11358 //
11359 //  check if the system was compiled with multitasking support
11360 //
11361 //==========================================================================
11362 int ufoIsMTaskEnabled (void) {
11363   #ifdef UFO_MTASK_ALLOWED
11364   return 1;
11365   #else
11366   return 0;
11367   #endif
11368 }