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 ;;
 265 ;;  argtype is the type of the argument that this word reads from the threaded code.
 266 ;;  possible argument types:
 267 ;;    0: none
 268 ;;    1: branch address
 269 ;;    2: cell-size numeric literal
 270 ;;    3: cell-counted string with terminating zero (not counted)
 271 ;;    4: cfa of another word
 272 ;;    5: cblock
 273 ;;    6: vocid
 274 ;;    7: byte-counted string with terminating zero (not counted)
 275 ;;    8: data skip: the arg is amout of bytes to skip (not including the counter itself)
 276
 277
 278 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 279 ;; wordlist structure (at PFA)
 280 ;; -4: wordlist type id (used by structs, for example)
 281 ;;   dd latest
 282 ;;   dd voclink (voclink always points here)
 283 ;;   dd parent (if not zero, all parent words are visible)
 284 ;;   dd header-nfa (can be 0 for anonymous wordlists)
 285 ;;   hashtable (if enabled), or ~0U if no hash table
 286 */
 287
 288
 289 // ////////////////////////////////////////////////////////////////////////// //
 290 #define UFO_BFA_TO_LFA(bfa_)    ((bfa_) + 1u * 4u)
 291 #define UFO_LFA_TO_XFA(lfa_)    ((lfa_) - 3u * 4u)
 292 #define UFO_LFA_TO_YFA(lfa_)    ((lfa_) - 2u * 4u)
 293 #define UFO_LFA_TO_BFA(lfa_)    ((lfa_) - 1u * 4u)
 294 #define UFO_LFA_TO_NFA(lfa_)    ((lfa_) + 2u * 4u)
 295 #define UFO_LFA_TO_CFA(lfa_)    UFO_ALIGN4((lfa_) + 3u * 4u + 1u + ufoImgGetU8((lfa_) + 2u * 4u))
 296 #define UFO_LFA_TO_NHASH(lfa_)  ((lfa_) + 1u * 4u)
 297 #define UFO_CFA_TO_NFA(cfa_)    ((cfa_) - 1u - 4u - ufoImgGetU8((cfa_) - 1u))
 298 #define UFO_CFA_TO_LFA(cfa_)    ((cfa_) - 1u - 4u * 3u - ufoImgGetU8((cfa_) - 1u))
 299 #define UFO_CFA_TO_PFA(cfa_)    ((cfa_) + 2u * 4u)
 300 #define UFO_PFA_TO_CFA(pfa_)    ((pfa_) - 2u * 4u)
 301 #define UFO_NFA_TO_CFA(nfa_)    UFO_ALIGN4((nfa_) + 4u + 1u + ufoImgGetU8((nfa_)))
 302 #define UFO_NFA_TO_LFA(nfa_)    ((nfa_) - 2u * 4u)
 303 #define UFO_XFA_TO_YFA(xfa_)    ((xfa_) + 4u)
 304 #define UFO_YFA_TO_XFA(yfa_)    ((xfa_) - 4u)
 305 #define UFO_YFA_TO_WST(yfa_)    ((yfa_) - 4u)  /* to xfa */
 306 #define UFO_YFA_TO_NFA(yfa_)    ((yfa_) + 4u * 4u)
 307
 308 #define UFO_CFA_TO_DOES_CFA(cfa_)  ((cfa_) + 4u)
 309 #define UFO_PFA_TO_DOES_CFA(pfa_)  ((pfa_) - 4u)
 310
 311
 312 // ////////////////////////////////////////////////////////////////////////// //
 313 #define UFW_VOCAB_OFS_LATEST   (0u * 4u)
 314 #define UFW_VOCAB_OFS_VOCLINK  (1u * 4u)
 315 #define UFW_VOCAB_OFS_PARENT   (2u * 4u)
 316 #define UFW_VOCAB_OFS_HEADER   (3u * 4u)
 317 #define UFW_VOCAB_OFS_HTABLE   (4u * 4u)
 318
 319 #define UFO_HASHTABLE_SIZE  (256)
 320
 321 #define UFO_NO_HTABLE_FLAG  (~(uint32_t)0)
 322
 323 #define UFO_MAX_NATIVE_CFAS  (1024u)
 324 static ufoNativeCFA ufoForthCFAs[UFO_MAX_NATIVE_CFAS];
 325 static uint32_t ufoCFAsUsed = 0;
 326
 327 static uint32_t ufoDoForthCFA;
 328 static uint32_t ufoDoVariableCFA;
 329 static uint32_t ufoDoValueCFA;
 330 static uint32_t ufoDoConstCFA;
 331 static uint32_t ufoDoDeferCFA;
 332 static uint32_t ufoDoDoesCFA;
 333 static uint32_t ufoDoRedirectCFA;
 334 static uint32_t ufoDoVocCFA;
 335 static uint32_t ufoDoCreateCFA;
 336 static uint32_t ufoDoUserVariableCFA;
 337
 338 static uint32_t ufoLitStr8CFA;
 339
 340 #ifdef UFO_MTASK_ALLOWED
 341 static uint32_t ufoSingleStepAllowed;
 342 #endif
 343
 344 // special address types:
 345 #define UFO_ADDR_CFA_BIT   ((uint32_t)1<<31)
 346 #define UFO_ADDR_CFA_MASK  (UFO_ADDR_CFA_BIT-1u)
 347
 348 // handles are somewhat special: first 12 bits can be used as offset for "@", and are ignored
 349 #define UFO_ADDR_HANDLE_BIT       ((uint32_t)1<<30)
 350 #define UFO_ADDR_HANDLE_MASK      ((UFO_ADDR_HANDLE_BIT-1u)&~((uint32_t)0xfff))
 351 #define UFO_ADDR_HANDLE_SHIFT     (12)
 352 #define UFO_ADDR_HANDLE_OFS_MASK  ((uint32_t)((1 << UFO_ADDR_HANDLE_SHIFT) - 1))
 353
 354 // temporary area is 1MB buffer out of the main image
 355 #define UFO_ADDR_TEMP_BIT   ((uint32_t)1<<29)
 356 #define UFO_ADDR_TEMP_MASK  (UFO_ADDR_TEMP_BIT-1u)
 357
 358 #define UFO_ADDR_SPECIAL_BITS_MASK  (UFO_ADDR_CFA_BIT|UFO_ADDR_HANDLE_BIT|UFO_ADDR_TEMP_BIT)
 359
 360
 361 #ifdef UFO_HUGE_IMAGES
 362 #define  ufoImageSize (1024u * 1024u * 64u)
 363 static uint32_t ufoImage[ufoImageSize / 4u];
 364 #else
 365 static uint32_t *ufoImage = NULL;
 366 static uint32_t ufoImageSize = 0;
 367 #endif
 368
 369 static uint8_t *ufoDebugImage = NULL;
 370 static uint32_t ufoDebugImageUsed = 0; // in bytes
 371 static uint32_t ufoDebugImageSize = 0; // in bytes
 372 static uint32_t ufoDebugFileNameHash = 0; // current file name hash
 373 static uint32_t ufoDebugFileNameLen = 0; // current file name length
 374 static uint32_t ufoDebugLastLine = 0;
 375 static uint32_t ufoDebugLastLinePCOfs = 0;
 376 static uint32_t ufoDebugLastLineDP = 0;
 377 static uint32_t ufoDebugCurrDP = 0;
 378
 379 static uint32_t ufoInRunWord = 0;
 380
 381 //static volatile int ufoVMAbort = 0;
 382
 383 #define ufoTrueValue  (~(uint32_t)0)
 384
 385 enum {
 386   UFO_MODE_NONE = -1,
 387   UFO_MODE_NATIVE = 0, // executing forth code
 388   UFO_MODE_MACRO = 1, // executing forth asm macro
 389 };
 390 static uint32_t ufoMode = UFO_MODE_NONE;
 391
 392 #define UFO_DSTACK_SIZE    (8192)
 393 #define UFO_RSTACK_SIZE    (4096)
 394 #define UFO_LSTACK_SIZE    (4096)
 395 #define UFO_MAX_TASK_NAME  (127)
 396 #define UFO_VOCSTACK_SIZE  (16u)
 397
 398 #define UFO_MAX_TEMP_IMAGE  (1024u * 1024u * 8u)
 399
 400 // to support multitasking (required for the debugger),
 401 // our virtual machine state is encapsulated in a struct.
 402 typedef struct UfoState_t {
 403   uint32_t id;
 404   uint32_t dStack[UFO_DSTACK_SIZE];
 405   uint32_t rStack[UFO_RSTACK_SIZE];
 406   uint32_t lStack[UFO_LSTACK_SIZE];
 407   uint32_t IP; // in image
 408   uint32_t SP; // points AFTER the last value pushed
 409   uint32_t RP; // points AFTER the last value pushed
 410   // address register
 411   uint32_t regA;
 412   // for locals
 413   uint32_t LP;
 414   uint32_t LBP;
 415   // vocstack
 416   uint32_t vocStack[UFO_VOCSTACK_SIZE]; // cfas
 417   uint32_t VSP;
 418   // temp image
 419   #ifdef UFO_HUGE_IMAGES
 420   uint32_t imageTemp[UFO_MAX_TEMP_IMAGE / 4u];
 421   #else
 422   uint32_t *imageTemp;
 423   uint32_t imageTempSize;
 424   #endif
 425   // linked list of all allocated states (tasks)
 426   char name[UFO_MAX_TASK_NAME + 1];
 427 } UfoState;
 428
 429 // 'cmon!
 430 #define UFO_MAX_STATES  (8192)
 431
 432 #ifdef UFO_MTASK_ALLOWED
 433 // this is indexed by id
 434 static UfoState *ufoStateMap[UFO_MAX_STATES] = {NULL};
 435 static uint32_t ufoStateUsedBitmap[UFO_MAX_STATES/32] = {0};
 436
 437 // currently active execution state
 438 static UfoState *ufoCurrState = NULL;
 439 // state we're yielded from
 440 static UfoState *ufoYieldedState = NULL;
 441 // if debug state is not NULL, VM will switch to it
 442 // after executing one instruction from the current state.
 443 // it will store current state in `ufoDebugeeState`.
 444 static UfoState *ufoDebuggerState = NULL;
 445 static uint32_t ufoSingleStep = 0;
 446
 447 #define ufoDStack         (ufoCurrState->dStack)
 448 #define ufoRStack         (ufoCurrState->rStack)
 449 #define ufoLStack         (ufoCurrState->lStack)
 450 #define ufoIP             (ufoCurrState->IP)
 451 #define ufoSP             (ufoCurrState->SP)
 452 #define ufoRP             (ufoCurrState->RP)
 453 #define ufoLP             (ufoCurrState->LP)
 454 #define ufoLBP            (ufoCurrState->LBP)
 455 #define ufoRegA           (ufoCurrState->regA)
 456 #define ufoImageTemp      (ufoCurrState->imageTemp)
 457 #ifdef UFO_HUGE_IMAGES
 458 # define ufoImageTempSize  UFO_MAX_TEMP_IMAGE
 459 # define ufoSTImageTempSize(st_)  UFO_MAX_TEMP_IMAGE
 460 #else
 461 # define ufoImageTempSize  (ufoCurrState->imageTempSize)
 462 # define ufoSTImageTempSize(st_)  ((st_)->imageTempSize)
 463 #endif
 464 #define ufoVocStack       (ufoCurrState->vocStack)
 465 #define ufoVSP            (ufoCurrState->VSP)
 466
 467 #else /* no multitasking */
 468
 469 static UfoState ufoCurrState;
 470
 471 #define ufoDStack         (ufoCurrState.dStack)
 472 #define ufoRStack         (ufoCurrState.rStack)
 473 #define ufoLStack         (ufoCurrState.lStack)
 474 #define ufoIP             (ufoCurrState.IP)
 475 #define ufoSP             (ufoCurrState.SP)
 476 #define ufoRP             (ufoCurrState.RP)
 477 #define ufoLP             (ufoCurrState.LP)
 478 #define ufoLBP            (ufoCurrState.LBP)
 479 #define ufoRegA           (ufoCurrState.regA)
 480 #define ufoImageTemp      (ufoCurrState.imageTemp)
 481 #ifdef UFO_HUGE_IMAGES
 482 # define ufoImageTempSize  UFO_MAX_TEMP_IMAGE
 483 # define ufoSTImageTempSize(st_)  UFO_MAX_TEMP_IMAGE
 484 #else
 485 # define ufoImageTempSize  (ufoCurrState.imageTempSize)
 486 # define ufoSTImageTempSize(st_)  ((st_)->imageTempSize)
 487 #endif
 488 #define ufoVocStack       (ufoCurrState.vocStack)
 489 #define ufoVSP            (ufoCurrState.VSP)
 490
 491 #endif
 492
 493 static jmp_buf ufoStopVMJP;
 494
 495 // 256 bytes for user variables
 496 #define UFO_USER_AREA_ADDR  UFO_ADDR_TEMP_BIT
 497 #define UFO_USER_AREA_SIZE  (256u)
 498 #define UFO_NBUF_ADDR       UFO_USER_AREA_ADDR + UFO_USER_AREA_SIZE
 499 #define UFO_NBUF_SIZE       (256u)
 500 #define UFO_PAD_ADDR        (UFO_NBUF_ADDR + UFO_NBUF_SIZE)
 501 #define UFO_DEF_TIB_ADDR    (UFO_PAD_ADDR + 2048u)
 502
 503 // dynamically allocated text input buffer
 504 // always ends with zero (this is word name too)
 505 static const uint32_t ufoAddrTIBx = UFO_ADDR_TEMP_BIT + 0u * 4u; // TIB
 506 static const uint32_t ufoAddrINx = UFO_ADDR_TEMP_BIT + 1u * 4u; // >IN
 507 static const uint32_t ufoAddrDefTIB = UFO_ADDR_TEMP_BIT + 2u * 4u; // default TIB (handle); user cannot change it
 508 static const uint32_t ufoAddrBASE = UFO_ADDR_TEMP_BIT + 3u * 4u;
 509 static const uint32_t ufoAddrSTATE = UFO_ADDR_TEMP_BIT + 4u * 4u;
 510 static const uint32_t ufoAddrContext = UFO_ADDR_TEMP_BIT + 5u * 4u; // CONTEXT
 511 static const uint32_t ufoAddrCurrent = UFO_ADDR_TEMP_BIT + 6u * 4u; // CURRENT (definitions will go there)
 512 static const uint32_t ufoAddrSelf = UFO_ADDR_TEMP_BIT + 7u * 4u; // CURRENT (definitions will go there)
 513 static const uint32_t ufoAddrInterNextLine = UFO_ADDR_TEMP_BIT + 8u * 4u; // (INTERPRET-NEXT-LINE)
 514 static const uint32_t ufoAddrEP = UFO_ADDR_TEMP_BIT + 9u * 4u; // (EP) -- exception frame pointer
 515 static const uint32_t ufoAddrDPTemp = UFO_ADDR_TEMP_BIT + 10u * 4u; // pointer to currently active DP in temp dict
 516 static const uint32_t ufoAddrHereDP = UFO_ADDR_TEMP_BIT + 11u * 4u; // pointer to currently active DP for HERE
 517 static const uint32_t ufoAddrUserVarUsed = UFO_ADDR_TEMP_BIT + 12u * 4u;
 518
 519 #define UFO_DPTEMP_BASE_ADDR  (UFO_ADDR_TEMP_BIT + 256u * 1024u)
 520
 521 static uint32_t ufoAddrVocLink;
 522 static uint32_t ufoAddrDP; // DP for main dict
 523 static uint32_t ufoAddrNewWordFlags;
 524 static uint32_t ufoAddrRedefineWarning;
 525 static uint32_t ufoAddrLastXFA;
 526
 527 static uint32_t ufoForthVocId;
 528 static uint32_t ufoCompilerVocId;
 529 static uint32_t ufoInterpNextLineCFA;
 530
 531 static uint32_t ufoUserAbortCFA;
 532
 533 // allows to redefine even protected words
 534 #define UFO_REDEF_WARN_DONT_CARE  (~(uint32_t)0)
 535 // do not warn about ordinary words, allow others
 536 #define UFO_REDEF_WARN_NONE    (0)
 537 // do warn (or fail on protected)
 538 #define UFO_REDEF_WARN_NORMAL  (1)
 539 // do warn (or fail on protected) for parent dicts too
 540 #define UFO_REDEF_WARN_PARENTS (2)
 541
 542 #define UFO_GET_DP()      (ufoImgGetU32(ufoImgGetU32(ufoAddrHereDP)))
 543
 544 #define UFO_MAX_NESTED_INCLUDES  (32)
 545 typedef struct {
 546   FILE *fl;
 547   char *fname;
 548   char *incpath;
 549   char *sysincpath;
 550   int fline;
 551   uint32_t id; // non-zero unique id
 552 } UFOFileStackEntry;
 553
 554 static UFOFileStackEntry ufoFileStack[UFO_MAX_NESTED_INCLUDES];
 555 static uint32_t ufoFileStackPos; // after the last used item
 556
 557 static FILE *ufoInFile = NULL;
 558 static uint32_t ufoInFileNameLen = 0;
 559 static uint32_t ufoInFileNameHash = 0;
 560 static char *ufoInFileName = NULL;
 561 static char *ufoLastIncPath = NULL;
 562 static char *ufoLastSysIncPath = NULL;
 563 static int ufoInFileLine = 0;
 564 static uint32_t ufoFileId = 0;
 565 static uint32_t ufoLastUsedFileId = 0;
 566 static int ufoLastEmitWasCR = 1;
 567 static long ufoCurrIncludeLineFileOfs = 0;
 568
 569 // dynamic memory handles
 570 typedef struct UHandleInfo_t {
 571   uint32_t ufoHandle;
 572   uint32_t typeid;
 573   uint8_t *data;
 574   uint32_t size;
 575   uint32_t used;
 576   // in free list
 577   struct UHandleInfo_t *next;
 578 } UfoHandle;
 579
 580 static UfoHandle *ufoHandleFreeList = NULL;
 581 static UfoHandle **ufoHandles = NULL;
 582 static uint32_t ufoHandlesUsed = 0;
 583 static uint32_t ufoHandlesAlloted = 0;
 584
 585 #define UFO_HANDLE_FREE  (~(uint32_t)0)
 586
 587 static char ufoCurrFileLine[520];
 588
 589 // for `ufoFatal()`
 590 static uint32_t ufoInBacktrace = 0;
 591
 592
 593 // ////////////////////////////////////////////////////////////////////////// //
 594 static void ufoClearCondDefines (void);
 595
 596 static void ufoBacktrace (uint32_t ip, int showDataStack);
 597 static void ufoBTShowWordName (uint32_t nfa);
 598
 599 static void ufoClearCondDefines (void);
 600
 601 #ifdef UFO_MTASK_ALLOWED
 602 static UfoState *ufoNewState (void);
 603 static void ufoFreeState (UfoState *st);
 604 static UfoState *ufoFindState (uint32_t stid);
 605 static void ufoSwitchToState (UfoState *newst);
 606 #endif
 607 static void ufoInitStateUserVars (UfoState *st);
 608
 609 __attribute__((unused)) static void ufoDumpWordHeader (const uint32_t lfa);
 610
 611 #ifndef WIN32
 612 static void ufoDisableRaw (void);
 613 #endif
 614 static void ufoTTYRawFlush (void);
 615 static int ufoIsGoodTTY (void);
 616
 617 #ifdef UFO_DEBUG_DEBUG
 618 static void ufoDumpDebugImage (void);
 619 #endif
 620
 621
 622 // ////////////////////////////////////////////////////////////////////////// //
 623 #ifdef UFO_MTASK_ALLOWED
 624 #define UFO_EXEC_CFA(cfa_)  do { \
 625   const uint32_t cfa = (cfa_); \
 626   if (ufoCurrState == NULL) ufoFatal("execution state is lost"); \
 627   const uint32_t cfaidx = ufoImgGetU32(cfa); \
 628   if (cfaidx >= UFO_ADDR_CFA_BIT && cfaidx < UFO_MAX_NATIVE_CFAS + UFO_ADDR_CFA_BIT) { \
 629     ufoForthCFAs[cfaidx & UFO_ADDR_CFA_MASK](UFO_CFA_TO_PFA(cfa)); \
 630   } else { \
 631     ufoFatal("tried to execute an unknown word: %u (max is %u); IP=%u", cfaidx, ufoCFAsUsed, ufoIP - 4u); \
 632   } \
 633   /* that's all we need to activate the debugger */ \
 634   if (ufoSingleStep) { \
 635     ufoSingleStep -= 1; \
 636     if (ufoSingleStep == 0 && ufoDebuggerState != NULL) { \
 637       if (ufoCurrState == ufoDebuggerState) ufoFatal("debugger cannot debug itself"); \
 638       UfoState *ost = ufoCurrState; \
 639       ufoSwitchToState(ufoDebuggerState); /* always use API call for this! */ \
 640       ufoPush(-2); \
 641       ufoPush(ost->id); \
 642     } \
 643   } \
 644 } while (0)
 645
 646 #else
 647
 648 #if 0
 649 # define UFO_EXEC_CFA_DEBUG  do { \
 650   fprintf(stderr, "IP:%08X CFA:%08X (CFA):%08X\n", ufoIP, xxcfa, xxcfaidx); \
 651   uint32_t nfa = ufoFindWordForIP(ufoIP - 4u); \
 652   if (nfa != 0) { \
 653     fprintf(stderr, "  IP: "); ufoBTShowWordName(nfa); \
 654     /*fname = ufoFindFileForIP(ip, &fline, NULL, NULL);*/ \
 655     /*if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }*/ \
 656     fputc('\n', stderr); \
 657   } \
 658   nfa = ufoFindWordForIP(xxcfa); \
 659   if (nfa != 0) { \
 660     fprintf(stderr, "  CFA:"); ufoBTShowWordName(nfa); \
 661     /*fname = ufoFindFileForIP(ip, &fline, NULL, NULL);*/ \
 662     /*if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }*/ \
 663     fputc('\n', stderr); \
 664   } \
 665 } while (0);
 666 #else
 667 # define UFO_EXEC_CFA_DEBUG
 668 #endif
 669
 670 #define UFO_EXEC_CFA(cfa__)  do { \
 671   const uint32_t xxcfa = (cfa__); \
 672   const uint32_t xxcfaidx = ufoImgGetU32(xxcfa); \
 673   UFO_EXEC_CFA_DEBUG \
 674   if (xxcfaidx >= UFO_ADDR_CFA_BIT && xxcfaidx < UFO_MAX_NATIVE_CFAS + UFO_ADDR_CFA_BIT) { \
 675     ufoForthCFAs[xxcfaidx & UFO_ADDR_CFA_MASK](UFO_CFA_TO_PFA(xxcfa)); \
 676   } else { \
 677     ufoFatal("tried to execute an unknown word: %u (max is %u); IP=%u; CFA=%u", \
 678              xxcfaidx, ufoCFAsUsed, ufoIP - 4u, xxcfa); \
 679   } \
 680 } while (0)
 681
 682 #endif
 683
 684
 685 // ////////////////////////////////////////////////////////////////////////// //
 686 #define UFWORD(name_) \
 687 static void ufoWord_##name_ (uint32_t mypfa)
 688
 689 #define UFCALL(name_)  ufoWord_##name_(0)
 690 #define UFCFA(name_)   (&ufoWord_##name_)
 691
 692 // for TIB words
 693 UFWORD(CPOKE_REGA_IDX);
 694
 695 // for peek and poke
 696 UFWORD(PAR_HANDLE_LOAD_BYTE);
 697 UFWORD(PAR_HANDLE_LOAD_WORD);
 698 UFWORD(PAR_HANDLE_LOAD_CELL);
 699 UFWORD(PAR_HANDLE_STORE_BYTE);
 700 UFWORD(PAR_HANDLE_STORE_WORD);
 701 UFWORD(PAR_HANDLE_STORE_CELL);
 702
 703
 704 //==========================================================================
 705 //
 706 //  ufoFlushOutput
 707 //
 708 //==========================================================================
 709 static void ufoFlushOutput (void) {
 710   ufoTTYRawFlush();
 711   fflush(NULL);
 712 }
 713
 714
 715 //==========================================================================
 716 //
 717 //  ufoSetInFileName
 718 //
 719 //  if `reuse` is not 0, reuse/free `fname`
 720 //
 721 //==========================================================================
 722 static void ufoSetInFileNameEx (const char *fname, int reuse) {
 723   ufo_assert(fname == NULL || (fname != ufoInFileName));
 724   if (fname == NULL || fname[0] == 0) {
 725     if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
 726     ufoInFileNameLen = 0;
 727     ufoInFileNameHash = 0;
 728     if (reuse && fname != NULL) free((void *)fname);
 729   } else {
 730     const uint32_t fnlen = (uint32_t)strlen(fname);
 731     const uint32_t fnhash = joaatHashBuf(fname, fnlen, 0);
 732     if (ufoInFileNameLen != fnlen || ufoInFileNameHash != fnhash) {
 733       if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
 734       if (reuse) {
 735         ufoInFileName = (char *)fname;
 736       } else {
 737         ufoInFileName = strdup(fname);
 738         if (ufoInFileName == NULL) ufoFatal("out of memory for filename info");
 739       }
 740       ufoInFileNameLen = fnlen;
 741       ufoInFileNameHash = fnhash;
 742     } else {
 743       if (reuse && fname != NULL) free((void *)fname);
 744     }
 745   }
 746 }
 747
 748
 749 //==========================================================================
 750 //
 751 //  ufoSetInFileName
 752 //
 753 //==========================================================================
 754 UFO_FORCE_INLINE void ufoSetInFileName (const char *fname) {
 755   ufoSetInFileNameEx(fname, 0);
 756 }
 757
 758
 759 //==========================================================================
 760 //
 761 //  ufoSetInFileNameReuse
 762 //
 763 //==========================================================================
 764 UFO_FORCE_INLINE void ufoSetInFileNameReuse (const char *fname) {
 765   ufoSetInFileNameEx(fname, 1);
 766 }
 767
 768
 769 //==========================================================================
 770 //
 771 //  ufoAllocHandle
 772 //
 773 //==========================================================================
 774 static UfoHandle *ufoAllocHandle (uint32_t typeid) {
 775   ufo_assert(typeid != UFO_HANDLE_FREE);
 776   UfoHandle *newh = ufoHandleFreeList;
 777   if (newh == NULL) {
 778     if (ufoHandlesUsed == ufoHandlesAlloted) {
 779       uint32_t newsz = ufoHandlesAlloted + 16384;
 780       // due to offsets, this is the maximum number of handles we can have
 781       if (newsz > 0x1ffffU) {
 782         if (ufoHandlesAlloted > 0x1ffffU) ufoFatal("too many dynamic handles");
 783         newsz = 0x1ffffU + 1U;
 784         ufo_assert(newsz > ufoHandlesAlloted);
 785       }
 786       UfoHandle **nh = realloc(ufoHandles, sizeof(ufoHandles[0]) * newsz);
 787       if (nh == NULL) ufoFatal("out of memory for handle table");
 788       ufoHandles = nh;
 789       ufoHandlesAlloted = newsz;
 790     }
 791     newh = calloc(1, sizeof(UfoHandle));
 792     if (newh == NULL) ufoFatal("out of memory for handle info");
 793     ufoHandles[ufoHandlesUsed] = newh;
 794     // setup new handle info
 795     newh->ufoHandle = (ufoHandlesUsed << UFO_ADDR_HANDLE_SHIFT) | UFO_ADDR_HANDLE_BIT;
 796     ufoHandlesUsed += 1;
 797   } else {
 798     ufo_assert(newh->typeid == UFO_HANDLE_FREE);
 799     ufoHandleFreeList = newh->next;
 800   }
 801   // setup new handle info
 802   newh->typeid = typeid;
 803   newh->data = NULL;
 804   newh->size = 0;
 805   newh->used = 0;
 806   newh->next = NULL;
 807   return newh;
 808 }
 809
 810
 811 //==========================================================================
 812 //
 813 //  ufoFreeHandle
 814 //
 815 //==========================================================================
 816 static void ufoFreeHandle (UfoHandle *hh) {
 817   if (hh != NULL) {
 818     ufo_assert(hh->typeid != UFO_HANDLE_FREE);
 819     if (hh->data) free(hh->data);
 820     hh->typeid = UFO_HANDLE_FREE;
 821     hh->data = NULL;
 822     hh->size = 0;
 823     hh->used = 0;
 824     hh->next = ufoHandleFreeList;
 825     ufoHandleFreeList = hh;
 826   }
 827 }
 828
 829
 830 //==========================================================================
 831 //
 832 //  ufoGetHandle
 833 //
 834 //==========================================================================
 835 static UfoHandle *ufoGetHandle (uint32_t hh) {
 836   UfoHandle *res;
 837   if (hh != 0 && (hh & UFO_ADDR_HANDLE_BIT) != 0) {
 838     hh = (hh & UFO_ADDR_HANDLE_MASK) >> UFO_ADDR_HANDLE_SHIFT;
 839     if (hh < ufoHandlesUsed) {
 840       res = ufoHandles[hh];
 841       if (res->typeid == UFO_HANDLE_FREE) res = NULL;
 842     } else {
 843       res = NULL;
 844     }
 845   } else {
 846     res = NULL;
 847   }
 848   return res;
 849 }
 850
 851
 852 #define POP_PREPARE_HANDLE_XX() \
 853   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle"); \
 854   if (idx > 0x1fffffffU - UFO_ADDR_HANDLE_OFS_MASK) ufoFatal("handle index %u out of range", idx); \
 855   idx += (hx & UFO_ADDR_HANDLE_OFS_MASK); \
 856   UfoHandle *hh = ufoGetHandle(hx); \
 857   if (hh == NULL) ufoFatal("invalid handle")
 858
 859 UFO_DISABLE_INLINE uint32_t ufoHandleLoadByte (uint32_t hx, uint32_t idx) {
 860   POP_PREPARE_HANDLE_XX();
 861   if (idx >= hh->size) ufoFatal("handle index %u out of range (%u)", idx, hh->size);
 862   return hh->data[idx];
 863 }
 864
 865 UFO_DISABLE_INLINE uint32_t ufoHandleLoadWord (uint32_t hx, uint32_t idx) {
 866   POP_PREPARE_HANDLE_XX();
 867   if (idx >= hh->size || hh->size - idx < 2u) {
 868     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
 869   }
 870   #ifdef UFO_FAST_MEM_ACCESS
 871   return *(const uint16_t *)(hh->data + idx);
 872   #else
 873   uint32_t res = hh->data[idx];
 874   res |= hh->data[idx + 1u] << 8;
 875   return res;
 876   #endif
 877 }
 878
 879 UFO_DISABLE_INLINE uint32_t ufoHandleLoadCell (uint32_t hx, uint32_t idx) {
 880   POP_PREPARE_HANDLE_XX();
 881   if (idx >= hh->size || hh->size - idx < 4u) {
 882     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
 883   }
 884   #ifdef UFO_FAST_MEM_ACCESS
 885   return *(const uint32_t *)(hh->data + idx);
 886   #else
 887   uint32_t res = hh->data[idx];
 888   res |= hh->data[idx + 1u] << 8;
 889   res |= hh->data[idx + 2u] << 16;
 890   res |= hh->data[idx + 3u] << 24;
 891   return res;
 892   #endif
 893 }
 894
 895 UFO_DISABLE_INLINE void ufoHandleStoreByte (uint32_t hx, uint32_t idx, uint32_t value) {
 896   POP_PREPARE_HANDLE_XX();
 897   if (idx >= hh->size) ufoFatal("handle index %u out of range (%u)", idx, hh->size);
 898   hh->data[idx] = (uint8_t)value;
 899 }
 900
 901 UFO_DISABLE_INLINE void ufoHandleStoreWord (uint32_t hx, uint32_t idx, uint32_t value) {
 902   POP_PREPARE_HANDLE_XX();
 903   if (idx >= hh->size || hh->size - idx < 2u) {
 904     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
 905   }
 906   #ifdef UFO_FAST_MEM_ACCESS
 907   *(uint16_t *)(hh->data + idx) = (uint16_t)value;
 908   #else
 909   hh->data[idx] = (uint8_t)value;
 910   hh->data[idx + 1u] = (uint8_t)(value >> 8);
 911   #endif
 912 }
 913
 914 UFO_DISABLE_INLINE void ufoHandleStoreCell (uint32_t hx, uint32_t idx, uint32_t value) {
 915   POP_PREPARE_HANDLE_XX();
 916   if (idx >= hh->size || hh->size - idx < 4u) {
 917     ufoFatal("handle index %u out of range (%u)", idx, hh->size);
 918   }
 919   #ifdef UFO_FAST_MEM_ACCESS
 920   *(uint32_t *)(hh->data + idx) = value;
 921   #else
 922   hh->data[idx] = (uint8_t)value;
 923   hh->data[idx + 1u] = (uint8_t)(value >> 8);
 924   hh->data[idx + 2u] = (uint8_t)(value >> 16);
 925   hh->data[idx + 3u] = (uint8_t)(value >> 24);
 926   #endif
 927 }
 928
 929
 930 //==========================================================================
 931 //
 932 //  setLastIncPath
 933 //
 934 //==========================================================================
 935 static void setLastIncPath (const char *fname, int system) {
 936   if (fname == NULL || fname[0] == 0) {
 937     if (system) {
 938       if (ufoLastSysIncPath) free(ufoLastIncPath);
 939       ufoLastSysIncPath = NULL;
 940     } else {
 941       if (ufoLastIncPath) free(ufoLastIncPath);
 942       ufoLastIncPath = strdup(".");
 943     }
 944   } else {
 945     char *lslash;
 946     char *cpos;
 947     if (system) {
 948       if (ufoLastSysIncPath) free(ufoLastSysIncPath);
 949       ufoLastSysIncPath = strdup(fname);
 950       lslash = ufoLastSysIncPath;
 951       cpos = ufoLastSysIncPath;
 952     } else {
 953       if (ufoLastIncPath) free(ufoLastIncPath);
 954       ufoLastIncPath = strdup(fname);
 955       lslash = ufoLastIncPath;
 956       cpos = ufoLastIncPath;
 957     }
 958     while (*cpos) {
 959       #ifdef WIN32
 960       if (*cpos == '/' || *cpos == '\\') lslash = cpos;
 961       #else
 962       if (*cpos == '/') lslash = cpos;
 963       #endif
 964       cpos += 1;
 965     }
 966     *lslash = 0;
 967   }
 968 }
 969
 970
 971 //==========================================================================
 972 //
 973 //  ufoClearIncludePath
 974 //
 975 //  required for UrAsm
 976 //
 977 //==========================================================================
 978 void ufoClearIncludePath (void) {
 979   if (ufoLastIncPath != NULL) {
 980     free(ufoLastIncPath);
 981     ufoLastIncPath = NULL;
 982   }
 983   if (ufoLastSysIncPath != NULL) {
 984     free(ufoLastSysIncPath);
 985     ufoLastSysIncPath = NULL;
 986   }
 987 }
 988
 989
 990 //==========================================================================
 991 //
 992 //  ufoErrorPrintFile
 993 //
 994 //==========================================================================
 995 static void ufoErrorPrintFile (FILE *fo, const char *errwarn) {
 996   if (ufoInFileName != NULL) {
 997     fprintf(fo, "UFO %s at file %s, line %d: ", errwarn, ufoInFileName, ufoInFileLine);
 998   } else {
 999     fprintf(fo, "UFO %s somewhere in time: ", errwarn);
1000   }
1001 }
1002
1003
1004 //==========================================================================
1005 //
1006 //  ufoErrorMsgV
1007 //
1008 //==========================================================================
1009 static void ufoErrorMsgV (const char *errwarn, const char *fmt, va_list ap) {
1010   ufoFlushOutput();
1011   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
1012   ufoErrorPrintFile(stderr, errwarn);
1013   vfprintf(stderr, fmt, ap);
1014   va_end(ap);
1015   fputc('\n', stderr);
1016   ufoFlushOutput();
1017 }
1018
1019
1020 //==========================================================================
1021 //
1022 //  ufoWarning
1023 //
1024 //==========================================================================
1025 __attribute__((format(printf, 1, 2)))
1026 void ufoWarning (const char *fmt, ...) {
1027   va_list ap;
1028   va_start(ap, fmt);
1029   ufoErrorMsgV("WARNING", fmt, ap);
1030 }
1031
1032
1033 //==========================================================================
1034 //
1035 //  ufoFatal
1036 //
1037 //==========================================================================
1038 __attribute__((noreturn)) __attribute__((format(printf, 1, 2)))
1039 void ufoFatal (const char *fmt, ...) {
1040   va_list ap;
1041   #ifndef WIN32
1042   ufoDisableRaw();
1043   #endif
1044   va_start(ap, fmt);
1045   ufoErrorMsgV("ERROR", fmt, ap);
1046   if (!ufoInBacktrace) {
1047     ufoInBacktrace = 1;
1048     ufoBacktrace(ufoIP, 1);
1049     ufoInBacktrace = 0;
1050   } else {
1051     fprintf(stderr, "DOUBLE FATAL: error in backtrace!\n");
1052     abort();
1053   }
1054   #ifdef UFO_DEBUG_FATAL_ABORT
1055   abort();
1056   #endif
1057   // allow restart
1058   ufoInRunWord = 0;
1059   ufoFatalError();
1060 }
1061
1062
1063 // ////////////////////////////////////////////////////////////////////////// //
1064 // working with the stacks
1065 #define UFO_TOS    (ufoDStack[ufoSP - 1u])
1066 #define UFO_RTOS   (ufoRStack[ufoRP - 1u])
1067
1068 #define UFO_S(n_)    (ufoDStack[ufoSP - 1u - (n_)])
1069 #define UFO_R(n_)    (ufoRStack[ufoRP - 1u - (n_)])
1070
1071 #define UFO_STACK(n_)   if (ufoSP < (uint32_t)(n_)) ufoFatal("data stack underflow")
1072 #define UFO_RSTACK(n_)  if (ufoRP < (uint32_t)(n_)) ufoFatal("return stack underflow")
1073
1074 UFO_FORCE_INLINE void ufoPush (uint32_t v) { if (ufoSP >= UFO_DSTACK_SIZE) ufoFatal("data stack overflow"); ufoDStack[ufoSP++] = v; }
1075 UFO_FORCE_INLINE void ufoDrop (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); ufoSP -= 1u; }
1076 UFO_FORCE_INLINE uint32_t ufoPop (void) { if (ufoSP == 0) { ufoFatal("data stack underflow"); } return ufoDStack[--ufoSP]; }
1077 UFO_FORCE_INLINE uint32_t ufoPeek (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); return ufoDStack[ufoSP-1u]; }
1078 UFO_FORCE_INLINE void ufoDup (void) { if (ufoSP == 0) ufoFatal("data stack underflow"); ufoPush(ufoDStack[ufoSP-1u]); }
1079 UFO_FORCE_INLINE void ufoOver (void) { if (ufoSP < 2u) ufoFatal("data stack underflow"); ufoPush(ufoDStack[ufoSP-2u]); }
1080 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; }
1081 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; }
1082 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; }
1083
1084 UFO_FORCE_INLINE void ufo2Dup (void) { ufoOver(); ufoOver(); }
1085 UFO_FORCE_INLINE void ufo2Drop (void) { UFO_STACK(2); ufoSP -= 2u; }
1086 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); }
1087 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; }
1088
1089 UFO_FORCE_INLINE void ufoRPush (uint32_t v) { if (ufoRP >= UFO_RSTACK_SIZE) ufoFatal("return stack overflow"); ufoRStack[ufoRP++] = v; }
1090 UFO_FORCE_INLINE void ufoRDrop (void) { if (ufoRP == 0) ufoFatal("return stack underflow"); --ufoRP; }
1091 UFO_FORCE_INLINE uint32_t ufoRPop (void) { if (ufoRP == 0) ufoFatal("return stack underflow"); return ufoRStack[--ufoRP]; }
1092 UFO_FORCE_INLINE uint32_t ufoRPeek (void) { if (ufoRP == 0) ufoFatal("return stack underflow"); return ufoRStack[ufoRP-1u]; }
1093 UFO_FORCE_INLINE void ufoRDup (void) { if (ufoRP == 0) ufoFatal("return stack underflow"); ufoPush(ufoRStack[ufoRP-1u]); }
1094
1095 UFO_FORCE_INLINE void ufoPushBool (int v) { ufoPush(v ? ufoTrueValue : 0u); }
1096
1097
1098 #ifndef UFO_HUGE_IMAGES
1099 //==========================================================================
1100 //
1101 //  ufoImgEnsureSize
1102 //
1103 //==========================================================================
1104 static void ufoImgEnsureSize (uint32_t addr) {
1105   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) != 0) ufoFatal("ufoImgEnsureSize: internal error");
1106   if (addr >= ufoImageSize) {
1107     // 64MB should be enough for everyone!
1108     if (addr >= 0x04000000U) {
1109       ufoFatal("image grown too big (addr=0%08XH)", addr);
1110     }
1111     const uint32_t osz = ufoImageSize;
1112     // grow by 1MB steps
1113     const uint32_t nsz = (addr|0x000fffffU) + 1U;
1114     ufo_assert(nsz > addr);
1115     uint32_t *nimg = realloc(ufoImage, nsz);
1116     if (nimg == NULL) {
1117       ufoFatal("out of memory for UFO image (%u -> %u MBs)",
1118                ufoImageSize / 1024u / 1024u,
1119                nsz / 1024u / 1024u);
1120     }
1121     ufoImage = nimg;
1122     ufoImageSize = nsz;
1123     memset((char *)ufoImage + osz, 0, (nsz - osz));
1124   }
1125 }
1126
1127
1128 //==========================================================================
1129 //
1130 //  ufoImgEnsureTemp
1131 //
1132 //==========================================================================
1133 static void ufoImgEnsureTemp (uint32_t addr) {
1134   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) != 0) ufoFatal("ufoImgEnsureTemp: internal error");
1135   if (addr >= ufoImageTempSize) {
1136     if (addr >= 1024u * 1024u) {
1137       ufoFatal("Forth segmentation fault at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1138     }
1139     const uint32_t osz = ufoImageTempSize;
1140     // grow by 64KB steps
1141     const uint32_t nsz = (addr|0x0000ffffU) + 1U;
1142     uint32_t *nimg = realloc(ufoImageTemp, nsz);
1143     if (nimg == NULL) {
1144       ufoFatal("out of memory for temp UFO image (%u -> %u KBs)",
1145                ufoImageTempSize / 1024u,
1146                nsz / 1024u);
1147     }
1148     ufoImageTemp = nimg;
1149     ufoImageTempSize = nsz;
1150     memset((char *)ufoImageTemp + osz, 0, (nsz - osz));
1151   }
1152 }
1153 #endif
1154
1155
1156 #ifdef UFO_FAST_MEM_ACCESS
1157 //==========================================================================
1158 //
1159 //  ufoImgPutU8
1160 //
1161 //  fast
1162 //
1163 //==========================================================================
1164 UFO_FORCE_INLINE void ufoImgPutU8 (uint32_t addr, const uint32_t value) {
1165   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1166     if (addr >= ufoImageSize) {
1167       #ifdef UFO_HUGE_IMAGES
1168       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1169       #else
1170       ufoImgEnsureSize(addr);
1171       #endif
1172     }
1173     *((uint8_t *)ufoImage + addr) = (uint8_t)value;
1174   } else if (addr & UFO_ADDR_TEMP_BIT) {
1175     addr &= UFO_ADDR_TEMP_MASK;
1176     if (addr >= ufoImageTempSize) {
1177       #ifdef UFO_HUGE_IMAGES
1178       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1179       #else
1180       ufoImgEnsureTemp(addr);
1181       #endif
1182     }
1183     *((uint8_t *)ufoImageTemp + addr) = (uint8_t)value;
1184   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1185     ufoHandleStoreByte(addr, 0, value);
1186   } else {
1187     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1188   }
1189 }
1190
1191
1192 //==========================================================================
1193 //
1194 //  ufoImgPutU16
1195 //
1196 //  fast
1197 //
1198 //==========================================================================
1199 UFO_FORCE_INLINE void ufoImgPutU16 (uint32_t addr, const uint32_t value) {
1200   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1201     if (addr + 1u >= ufoImageSize) {
1202       #ifdef UFO_HUGE_IMAGES
1203       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1204       #else
1205       ufoImgEnsureSize(addr + 1u);
1206       #endif
1207     }
1208     *(uint16_t *)((uint8_t *)ufoImage + addr) = (uint16_t)value;
1209   } else if (addr & UFO_ADDR_TEMP_BIT) {
1210     addr &= UFO_ADDR_TEMP_MASK;
1211     if (addr + 1u >= ufoImageTempSize) {
1212       #ifdef UFO_HUGE_IMAGES
1213       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1214       #else
1215       ufoImgEnsureTemp(addr + 1u);
1216       #endif
1217     }
1218     *(uint16_t *)((uint8_t *)ufoImageTemp + addr) = (uint16_t)value;
1219   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1220     ufoHandleStoreWord(addr, 0, value);
1221   } else {
1222     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1223   }
1224 }
1225
1226
1227 //==========================================================================
1228 //
1229 //  ufoImgPutU32
1230 //
1231 //  fast
1232 //
1233 //==========================================================================
1234 UFO_FORCE_INLINE void ufoImgPutU32 (uint32_t addr, const uint32_t value) {
1235   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1236     if (addr + 3u >= ufoImageSize) {
1237       #ifdef UFO_HUGE_IMAGES
1238       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1239       #else
1240       ufoImgEnsureSize(addr + 3u);
1241       #endif
1242     }
1243     *(uint32_t *)((uint8_t *)ufoImage + addr) = value;
1244   } else if (addr & UFO_ADDR_TEMP_BIT) {
1245     addr &= UFO_ADDR_TEMP_MASK;
1246     if (addr + 3u >= ufoImageTempSize) {
1247       #ifdef UFO_HUGE_IMAGES
1248       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1249       #else
1250       ufoImgEnsureTemp(addr + 3u);
1251       #endif
1252     }
1253     *(uint32_t *)((uint8_t *)ufoImageTemp + addr) = value;
1254   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1255     ufoHandleStoreCell(addr, 0, value);
1256   } else {
1257     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1258   }
1259 }
1260
1261
1262 //==========================================================================
1263 //
1264 //  ufoImgGetU8
1265 //
1266 //  false
1267 //
1268 //==========================================================================
1269 UFO_FORCE_INLINE uint32_t ufoImgGetU8 (uint32_t addr) {
1270   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1271     if (addr >= ufoImageSize) {
1272       // accessing unallocated image area is segmentation fault
1273       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1274     }
1275     return *((const uint8_t *)ufoImage + addr);
1276   } else if (addr & UFO_ADDR_TEMP_BIT) {
1277     addr &= UFO_ADDR_TEMP_MASK;
1278     if (addr >= ufoImageTempSize) {
1279       // accessing unallocated image area is segmentation fault
1280       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1281     }
1282     return *((const uint8_t *)ufoImageTemp + addr);
1283   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1284     return ufoHandleLoadByte(addr, 0);
1285   } else {
1286     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1287   }
1288 }
1289
1290
1291 //==========================================================================
1292 //
1293 //  ufoImgGetU16
1294 //
1295 //  fast
1296 //
1297 //==========================================================================
1298 UFO_FORCE_INLINE uint32_t ufoImgGetU16 (uint32_t addr) {
1299   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1300     if (addr + 1u >= ufoImageSize) {
1301       // accessing unallocated image area is segmentation fault
1302       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1303     }
1304     return *(const uint16_t *)((const uint8_t *)ufoImage + addr);
1305   } else if (addr & UFO_ADDR_TEMP_BIT) {
1306     addr &= UFO_ADDR_TEMP_MASK;
1307     if (addr + 1u >= ufoImageTempSize) {
1308       // accessing unallocated image area is segmentation fault
1309       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1310     }
1311     return *(const uint16_t *)((const uint8_t *)ufoImageTemp + addr);
1312   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1313     return ufoHandleLoadWord(addr, 0);
1314   } else {
1315     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1316   }
1317 }
1318
1319
1320 //==========================================================================
1321 //
1322 //  ufoImgGetU32
1323 //
1324 //  fast
1325 //
1326 //==========================================================================
1327 UFO_FORCE_INLINE uint32_t ufoImgGetU32 (uint32_t addr) {
1328   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1329     if (addr + 3u >= ufoImageSize) {
1330       // accessing unallocated image area is segmentation fault
1331       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1332     }
1333     return *(const uint32_t *)((const uint8_t *)ufoImage + addr);
1334   } else if (addr & UFO_ADDR_TEMP_BIT) {
1335     addr &= UFO_ADDR_TEMP_MASK;
1336     if (addr + 3u >= ufoImageTempSize) {
1337       // accessing unallocated image area is segmentation fault
1338       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr | UFO_ADDR_TEMP_BIT);
1339     }
1340     return *(const uint32_t *)((const uint8_t *)ufoImageTemp + addr);
1341   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1342     return ufoHandleLoadCell(addr, 0);
1343   } else {
1344     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1345   }
1346 }
1347
1348 #else
1349
1350 //==========================================================================
1351 //
1352 //  ufoImgPutU8
1353 //
1354 //  general
1355 //
1356 //==========================================================================
1357 UFO_FORCE_INLINE void ufoImgPutU8 (uint32_t addr, const uint32_t value) {
1358   uint32_t *imgptr;
1359   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1360     if (addr >= ufoImageSize) {
1361       #ifdef UFO_HUGE_IMAGES
1362       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1363       #else
1364       ufoImgEnsureSize(addr);
1365       #endif
1366     }
1367     imgptr = &ufoImage[addr/4u];
1368   } else if (addr & UFO_ADDR_TEMP_BIT) {
1369     addr &= UFO_ADDR_TEMP_MASK;
1370     if (addr >= ufoImageTempSize) {
1371       #ifdef UFO_HUGE_IMAGES
1372       ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1373       #else
1374       ufoImgEnsureTemp(addr);
1375       #endif
1376     }
1377     imgptr = &ufoImageTemp[addr/4u];
1378   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1379     ufoHandleStoreByte(addr, 0, value);
1380   } else {
1381     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1382   }
1383   const uint8_t val = (uint8_t)value;
1384   memcpy((uint8_t *)imgptr + (addr&3), &val, 1);
1385 }
1386
1387
1388 //==========================================================================
1389 //
1390 //  ufoImgPutU16
1391 //
1392 //  general
1393 //
1394 //==========================================================================
1395 UFO_FORCE_INLINE void ufoImgPutU16 (uint32_t addr, const uint32_t value) {
1396   ufoImgPutU8(addr, value&0xffU);
1397   ufoImgPutU8(addr + 1u, (value>>8)&0xffU);
1398 }
1399
1400
1401 //==========================================================================
1402 //
1403 //  ufoImgPutU32
1404 //
1405 //  general
1406 //
1407 //==========================================================================
1408 UFO_FORCE_INLINE void ufoImgPutU32 (uint32_t addr, const uint32_t value) {
1409   ufoImgPutU16(addr, value&0xffffU);
1410   ufoImgPutU16(addr + 2u, (value>>16)&0xffffU);
1411 }
1412
1413
1414 //==========================================================================
1415 //
1416 //  ufoImgGetU8
1417 //
1418 //  general
1419 //
1420 //==========================================================================
1421 UFO_FORCE_INLINE uint32_t ufoImgGetU8 (uint32_t addr) {
1422   uint32_t *imgptr;
1423   if ((addr & UFO_ADDR_SPECIAL_BITS_MASK) == 0) {
1424     if (addr >= ufoImageSize) {
1425       // accessing unallocated image area is segmentation fault
1426       ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr);
1427     }
1428     imgptr = &ufoImage[addr/4u];
1429   } else if (addr & UFO_ADDR_TEMP_BIT) {
1430     addr &= UFO_ADDR_TEMP_MASK;
1431     if (addr >= ufoImageTempSize) return 0;
1432     imgptr = &ufoImageTemp[addr/4u];
1433   } else if ((addr & UFO_ADDR_HANDLE_BIT) != 0) {
1434     return ufoHandleLoadByte(addr, 0, value);
1435   } else {
1436     ufoFatal("Forth segmentation fault at address 0x%08X", addr);
1437   }
1438   uint8_t val;
1439   memcpy(&val, (uint8_t *)imgptr + (addr&3), 1);
1440   return (uint32_t)val;
1441 }
1442
1443
1444 //==========================================================================
1445 //
1446 //  ufoImgGetU16
1447 //
1448 //  general
1449 //
1450 //==========================================================================
1451 UFO_FORCE_INLINE uint32_t ufoImgGetU16 (uint32_t addr) {
1452   return ufoImgGetU8(addr) | (ufoImgGetU8(addr + 1u) << 8);
1453 }
1454
1455
1456 //==========================================================================
1457 //
1458 //  ufoImgGetU32
1459 //
1460 //  general
1461 //
1462 //==========================================================================
1463 UFO_FORCE_INLINE uint32_t ufoImgGetU32 (uint32_t addr) {
1464   return ufoImgGetU16(addr) | (ufoImgGetU16(addr + 2u) << 16);
1465 }
1466 #endif
1467
1468
1469 //==========================================================================
1470 //
1471 //  ufoEnsureDebugSize
1472 //
1473 //==========================================================================
1474 UFO_DISABLE_INLINE void ufoEnsureDebugSize (uint32_t sdelta) {
1475   ufo_assert(sdelta != 0);
1476   if (ufoDebugImageSize != 0) {
1477     if (ufoDebugImageUsed + sdelta >= 0x40000000U) ufoFatal("debug info too big");
1478     if (ufoDebugImageUsed + sdelta > ufoDebugImageSize) {
1479       // grow by 32KB, this should be more than enough
1480       const uint32_t newsz = ((ufoDebugImageUsed + sdelta) | 0x7fffU) + 1u;
1481       uint8_t *ndb = realloc(ufoDebugImage, newsz);
1482       if (ndb == NULL) ufoFatal("out of memory for debug info");
1483       ufoDebugImage = ndb;
1484       ufoDebugImageSize = newsz;
1485     }
1486   } else {
1487     // initial allocation: 32KB, quite a lot
1488     ufo_assert(ufoDebugImage == NULL);
1489     ufo_assert(ufoDebugImageUsed == 0);
1490     ufoDebugImageSize = 1024 * 32;
1491     ufoDebugImage = malloc(ufoDebugImageSize);
1492     if (ufoDebugImage == NULL) ufoFatal("out of memory for debug info");
1493   }
1494 }
1495
1496
1497 #define UFO_DBG_PUT_U4(val_)  do { \
1498   const uint32_t vv_ = (val_); \
1499   *((uint32_t *)(ufoDebugImage + ufoDebugImageUsed)) = vv_; \
1500   ufoDebugImageUsed += 4u; \
1501 } while (0)
1502
1503
1504 /*
1505   debug info header:
1506     dd lastFileInfoOfs
1507     ...first line info header...
1508   line info header (or reset):
1509     db 0   ; zero line delta
1510     dw followFileInfoSize  ; either it, or 0 if reused
1511     dd fileInfoOfs         ; present only if reused
1512   lines:
1513     dv lineDelta
1514     dv pcBytes
1515
1516   file info record:
1517     dd prevFileInfoOfs
1518     dd fileNameHash
1519     dd nameLen  ; without terminating 0
1520     ...name... (0-terminated)
1521
1522   we will never compare file names: length and hash should provide
1523   good enough unique identifier.
1524
1525 static uint8_t *ufoDebugImage = NULL;
1526 static uint32_t ufoDebugImageUsed = 0; // in bytes
1527 static uint32_t ufoDebugImageSize = 0; // in bytes
1528 static uint32_t ufoDebugFileNameHash = 0; // current file name hash
1529 static uint32_t ufoDebugFileNameLen = 0; // current file name length
1530 static uint32_t ufoDebugCurrDP = 0;
1531 */
1532
1533
1534 //==========================================================================
1535 //
1536 //  ufoSkipDebugVarInt
1537 //
1538 //==========================================================================
1539 static __attribute__((unused)) uint32_t ufoSkipDebugVarInt (uint32_t ofs) {
1540   uint8_t byte;
1541   do {
1542     if (ofs >= ufoDebugImageUsed) ufoFatal("invalid debug data");
1543     byte = ufoDebugImage[ofs]; ofs += 1u;
1544   } while (byte >= 0x80);
1545   return ofs;
1546 }
1547
1548
1549 //==========================================================================
1550 //
1551 //  ufoCalcDebugVarIntSize
1552 //
1553 //==========================================================================
1554 UFO_FORCE_INLINE uint8_t ufoCalcDebugVarIntSize (uint32_t v) {
1555   uint8_t count = 0;
1556   do {
1557     count += 1u;
1558     v >>= 7;
1559   } while (v != 0);
1560   return count;
1561 }
1562
1563
1564 //==========================================================================
1565 //
1566 //  ufoGetDebugVarInt
1567 //
1568 //==========================================================================
1569 static __attribute__((unused)) uint32_t ufoGetDebugVarInt (uint32_t ofs) {
1570   uint32_t v = 0;
1571   uint8_t shift = 0;
1572   uint8_t byte;
1573   do {
1574     if (ofs >= ufoDebugImageUsed) ufoFatal("invalid debug data");
1575     byte = ufoDebugImage[ofs];
1576     v |= (uint32_t)(byte & 0x7f) << shift;
1577     if (byte >= 0x80) {
1578       shift += 7;
1579       ofs += 1u;
1580     }
1581   } while (byte >= 0x80);
1582   return v;
1583 }
1584
1585
1586 //==========================================================================
1587 //
1588 //  ufoPutDebugVarInt
1589 //
1590 //==========================================================================
1591 UFO_FORCE_INLINE void ufoPutDebugVarInt (uint32_t v) {
1592   ufoEnsureDebugSize(5u); // maximum size
1593   do {
1594     if (v >= 0x80) {
1595       ufoDebugImage[ufoDebugImageUsed] = (uint8_t)(v | 0x80u);
1596     } else {
1597       ufoDebugImage[ufoDebugImageUsed] = (uint8_t)v;
1598     }
1599     ufoDebugImageUsed += 1;
1600     v >>= 7;
1601   } while (v != 0);
1602 }
1603
1604
1605 #ifdef UFO_DEBUG_DEBUG
1606 //==========================================================================
1607 //
1608 //  ufoDumpDebugInfo
1609 //
1610 //==========================================================================
1611 static void ufoDumpDebugImage (void) {
1612   #if 0
1613   uint32_t dbgpos = 4u; // first line header info
1614   uint32_t lastline = 0;
1615   uint32_t lastdp = 0;
1616   while (dbgpos < ufoDebugImageUsed) {
1617     if (ufoDebugImage[dbgpos] == 0) {
1618       // new file info
1619       dbgpos += 1u; // skip flag
1620       const uint32_t fhdrSize = *(const uint16_t *)(ufoDebugImage + dbgpos); dbgpos += 2u;
1621       lastdp = ufoGetDebugVarInt(dbgpos);
1622       dbgpos = ufoSkipDebugVarInt(dbgpos);
1623       if (fhdrSize == 0) {
1624         // reused
1625         const uint32_t infoOfs = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1626         fprintf(stderr, "*** OLD FILE: %s\n", (const char *)(ufoDebugImage + infoOfs + 3u * 4u));
1627         fprintf(stderr, "FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + infoOfs))[2]);
1628         fprintf(stderr, "FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + infoOfs))[1]);
1629       } else {
1630         // new
1631         fprintf(stderr, "*** NEW FILE: %s\n", (const char *)(ufoDebugImage + dbgpos + 3u * 4u));
1632         fprintf(stderr, "FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + dbgpos))[2]);
1633         fprintf(stderr, "FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + dbgpos))[1]);
1634       }
1635       dbgpos += fhdrSize;
1636       fprintf(stderr, "LINES-OFS: 0x%08x (hsz: %u -- 0x%08x)\n", dbgpos, fhdrSize, fhdrSize);
1637       lastline = ~(uint32_t)0;
1638     } else {
1639       const uint32_t ln = ufoGetDebugVarInt(dbgpos);
1640       dbgpos = ufoSkipDebugVarInt(dbgpos);
1641       ufo_assert(ln != 0);
1642       lastline += ln;
1643       const uint32_t edp = ufoGetDebugVarInt(dbgpos);
1644       dbgpos = ufoSkipDebugVarInt(dbgpos);
1645       lastdp += edp;
1646       fprintf(stderr, "  line %6u: edp=%u\n", lastline, lastdp);
1647     }
1648   }
1649   #endif
1650 }
1651 #endif
1652
1653
1654 //==========================================================================
1655 //
1656 //  ufoRecordDebugCheckFile
1657 //
1658 //  if we moved to the new file:
1659 //    put "line info header"
1660 //    put new file info (or reuse old)
1661 //
1662 //==========================================================================
1663 UFO_FORCE_INLINE void ufoRecordDebugCheckFile (void) {
1664   if (ufoDebugImageUsed == 0 ||
1665       ufoDebugFileNameLen != ufoInFileNameLen ||
1666       ufoDebugFileNameHash != ufoInFileNameHash)
1667   {
1668     // new file record (or reuse old one)
1669     const int initial = (ufoDebugImageUsed == 0);
1670     uint32_t fileRec = 0;
1671     // try to find and old one
1672     if (!initial) {
1673       fileRec = *(const uint32_t *)ufoDebugImage;
1674       #if 0
1675       fprintf(stderr, "*** NEW-FILE(%u): 0x%08x: <%s> (frec=0x%08x)\n", ufoInFileNameLen,
1676               ufoInFileNameHash, ufoInFileName, fileRec);
1677       #endif
1678       while (fileRec != 0 &&
1679              (ufoInFileNameLen != ((const uint32_t *)(ufoDebugImage + fileRec))[1] ||
1680               ufoInFileNameHash != ((const uint32_t *)(ufoDebugImage + fileRec))[2]))
1681       {
1682         #if 0
1683         fprintf(stderr, "*** FRCHECK: 0x%08x\n", fileRec);
1684         fprintf(stderr, "  FILE NAME: %s\n", (const char *)(ufoDebugImage + fileRec + 3u * 4u));
1685         fprintf(stderr, "  FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + fileRec))[2]);
1686         fprintf(stderr, "  FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + fileRec))[1]);
1687         fprintf(stderr, "  FILE PREV: 0x%08x\n", *(const uint32_t *)(ufoDebugImage + fileRec));
1688         #endif
1689         fileRec = *(const uint32_t *)(ufoDebugImage + fileRec);
1690       }
1691       #if 0
1692       fprintf(stderr, "*** FRCHECK-DONE: 0x%08x\n", fileRec);
1693       if (fileRec != 0) {
1694         fprintf(stderr, "    FILE NAME: %s\n", (const char *)(ufoDebugImage + fileRec + 3u * 4u));
1695         fprintf(stderr, "    FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage + fileRec))[2]);
1696         fprintf(stderr, "    FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage + fileRec))[1]);
1697         fprintf(stderr, "    FILE PREV: 0x%08x\n", *(const uint32_t *)(ufoDebugImage + fileRec));
1698       }
1699       #endif
1700     } else {
1701       ufoEnsureDebugSize(8u);
1702       *(uint32_t *)ufoDebugImage = 0;
1703     }
1704     // write "line info header"
1705     if (fileRec != 0) {
1706       ufoEnsureDebugSize(32u);
1707       ufoDebugImage[ufoDebugImageUsed] = 0; ufoDebugImageUsed += 1u; // header flag (0 delta)
1708       // file record size: 0 (reused)
1709       *((uint16_t *)(ufoDebugImage + ufoDebugImageUsed)) = 0; ufoDebugImageUsed += 2u;
1710       // put last DP
1711       ufoPutDebugVarInt(ufoDebugCurrDP);
1712       // file info offset
1713       UFO_DBG_PUT_U4(fileRec);
1714     } else {
1715       // name, trailing 0 byte, 3 dword fields
1716       const uint32_t finfoSize = ufoInFileNameLen + 1u + 3u * 4u;
1717       ufo_assert(finfoSize < 65536u);
1718       ufoEnsureDebugSize(finfoSize + 32u);
1719       if (initial) {
1720         *(uint32_t *)ufoDebugImage = 0;
1721         ufoDebugImageUsed = 4;
1722       }
1723       ufoDebugImage[ufoDebugImageUsed] = 0; ufoDebugImageUsed += 1u; // header flag (0 delta)
1724       // file record size
1725       *((uint16_t *)(ufoDebugImage + ufoDebugImageUsed)) = (uint16_t)finfoSize; ufoDebugImageUsed += 2u;
1726       // put last DP
1727       ufoPutDebugVarInt(ufoDebugCurrDP);
1728       // file record follows
1729       // fix file info offsets
1730       uint32_t lastOfs = *(const uint32_t *)ufoDebugImage;
1731       *(uint32_t *)ufoDebugImage = ufoDebugImageUsed;
1732       UFO_DBG_PUT_U4(lastOfs);
1733       // save file info hash
1734       UFO_DBG_PUT_U4(ufoInFileNameHash);
1735       // save file info length
1736       UFO_DBG_PUT_U4(ufoInFileNameLen);
1737       // save file name
1738       if (ufoInFileNameLen != 0) {
1739         memcpy(ufoDebugImage + ufoDebugImageUsed, ufoInFileName, ufoInFileNameLen + 1u);
1740         ufoDebugImageUsed += ufoInFileNameLen + 1u;
1741       } else {
1742         ufoDebugImage[ufoDebugImageUsed] = 0; ufoDebugImageUsed += 1u;
1743       }
1744     }
1745     ufoDebugFileNameLen = ufoInFileNameLen;
1746     ufoDebugFileNameHash = ufoInFileNameHash;
1747     ufoDebugLastLine = ~(uint32_t)0;
1748     ufoDebugLastLinePCOfs = 0;
1749     ufoDebugLastLineDP = ufoDebugCurrDP;
1750   }
1751 }
1752
1753
1754 //==========================================================================
1755 //
1756 //  ufoRecordDebugRecordLine
1757 //
1758 //==========================================================================
1759 UFO_FORCE_INLINE void ufoRecordDebugRecordLine (uint32_t line, uint32_t newhere) {
1760   if (line == ufoDebugLastLine) {
1761     ufo_assert(ufoDebugLastLinePCOfs != 0);
1762     ufoDebugImageUsed = ufoDebugLastLinePCOfs;
1763   } else {
1764     #if 0
1765     fprintf(stderr, "FL-NEW-LINE(0x%08x): <%s>; new line: %u (old: %u)\n",
1766             ufoDebugImageUsed,
1767             ufoInFileName, line, ufoDebugLastLine);
1768     #endif
1769     ufoPutDebugVarInt(line - ufoDebugLastLine);
1770     ufoDebugLastLinePCOfs = ufoDebugImageUsed;
1771     ufoDebugLastLine = line;
1772     ufoDebugLastLineDP = ufoDebugCurrDP;
1773   }
1774   ufoPutDebugVarInt(newhere - ufoDebugLastLineDP);
1775   ufoDebugCurrDP = newhere;
1776 }
1777
1778
1779 //==========================================================================
1780 //
1781 //  ufoRecordDebug
1782 //
1783 //==========================================================================
1784 UFO_DISABLE_INLINE void ufoRecordDebug (uint32_t newhere) {
1785   if (newhere > ufoDebugCurrDP) {
1786     uint32_t ln = (uint32_t)ufoInFileLine;
1787     if (ln == ~(uint32_t)0) ln = 0;
1788     #if 0
1789     fprintf(stderr, "FL: <%s>; line: %d\n", ufoInFileName, ufoInFileLine);
1790     #endif
1791     ufoRecordDebugCheckFile();
1792     ufoRecordDebugRecordLine(ln, newhere);
1793   }
1794 }
1795
1796
1797 //==========================================================================
1798 //
1799 //  ufoGetWordEndAddrYFA
1800 //
1801 //==========================================================================
1802 static uint32_t ufoGetWordEndAddrYFA (uint32_t yfa) {
1803   if (yfa > 8u) {
1804     const uint32_t oyfa = yfa;
1805     yfa = ufoImgGetU32(yfa); // YFA points to next YFA
1806     if (yfa == 0) {
1807       // last defined word
1808       if ((oyfa & UFO_ADDR_TEMP_BIT) == 0) {
1809         yfa = ufoImgGetU32(ufoAddrDP);
1810       } else {
1811         yfa = ufoImgGetU32(ufoAddrDPTemp);
1812       }
1813     } else {
1814       yfa = UFO_YFA_TO_WST(yfa);
1815     }
1816   } else {
1817     yfa = 0;
1818   }
1819   return yfa;
1820 }
1821
1822
1823 //==========================================================================
1824 //
1825 //  ufoGetWordEndAddr
1826 //
1827 //==========================================================================
1828 static uint32_t ufoGetWordEndAddr (const uint32_t cfa) {
1829   if (cfa != 0) {
1830     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
1831     const uint32_t yfa = UFO_LFA_TO_YFA(lfa);
1832     return ufoGetWordEndAddrYFA(yfa);
1833   } else {
1834     return 0;
1835   }
1836 }
1837
1838
1839 //==========================================================================
1840 //
1841 //  ufoFindWordForIP
1842 //
1843 //  return NFA or 0
1844 //
1845 //  WARNING: this is SLOW!
1846 //
1847 //==========================================================================
1848 static uint32_t ufoFindWordForIP (const uint32_t ip) {
1849   uint32_t res = 0;
1850   if (ip != 0) {
1851     //fprintf(stderr, "ufoFindWordForIP:000: ip=0x%08x\n", ip);
1852     // iterate over all words
1853     uint32_t xfa = ufoImgGetU32(ufoAddrLastXFA);
1854     //fprintf(stderr, "ufoFindWordForIP:001: xfa=0x%08x\n", xfa);
1855     if (xfa != 0) {
1856       while (res == 0 && xfa != 0) {
1857         const uint32_t yfa = UFO_XFA_TO_YFA(xfa);
1858         const uint32_t wst = UFO_YFA_TO_WST(yfa);
1859         //fprintf(stderr, "ufoFindWordForIP:002:   yfa=0x%08x; wst=0x%08x\n", yfa, wst);
1860         const uint32_t wend = ufoGetWordEndAddrYFA(yfa);
1861         if (ip >= wst && ip < wend) {
1862           res = UFO_YFA_TO_NFA(yfa);
1863         } else {
1864           xfa = ufoImgGetU32(xfa);
1865         }
1866       }
1867     }
1868   }
1869   return res;
1870 }
1871
1872
1873 //==========================================================================
1874 //
1875 //  ufoFindFileForIP
1876 //
1877 //  return file name or `NULL`
1878 //
1879 //  WARNING: this is SLOW!
1880 //
1881 //==========================================================================
1882 static const char *ufoFindFileForIP (uint32_t ip, uint32_t *line,
1883                                      uint32_t *nlen, uint32_t *nhash)
1884 {
1885   if (ip != 0 && ufoDebugImageUsed != 0) {
1886     const char *filename = NULL;
1887     uint32_t dbgpos = 4u; // first line header info
1888     uint32_t lastline = 0;
1889     uint32_t lastdp = 0;
1890     uint32_t namelen = 0;
1891     uint32_t namehash = 0;
1892     while (dbgpos < ufoDebugImageUsed) {
1893       if (ufoDebugImage[dbgpos] == 0) {
1894         // new file info
1895         dbgpos += 1u; // skip flag
1896         const uint32_t fhdrSize = *(const uint16_t *)(ufoDebugImage + dbgpos); dbgpos += 2u;
1897         lastdp = ufoGetDebugVarInt(dbgpos);
1898         dbgpos = ufoSkipDebugVarInt(dbgpos);
1899         uint32_t infoOfs;
1900         if (fhdrSize == 0) {
1901           // reused
1902           infoOfs = *(const uint32_t *)(ufoDebugImage + dbgpos); dbgpos += 4u;
1903         } else {
1904           // new
1905           infoOfs = dbgpos;
1906         }
1907         filename = (const char *)(ufoDebugImage + infoOfs + 3u * 4u);
1908         namelen = ((const uint32_t *)(ufoDebugImage + infoOfs))[2];
1909         namehash = ((const uint32_t *)(ufoDebugImage + infoOfs))[1];
1910         if (filename[0] == 0) filename = NULL;
1911         dbgpos += fhdrSize;
1912         lastline = ~(uint32_t)0;
1913       } else {
1914         const uint32_t ln = ufoGetDebugVarInt(dbgpos);
1915         dbgpos = ufoSkipDebugVarInt(dbgpos);
1916         ufo_assert(ln != 0);
1917         lastline += ln;
1918         const uint32_t edp = ufoGetDebugVarInt(dbgpos);
1919         dbgpos = ufoSkipDebugVarInt(dbgpos);
1920         if (ip >= lastdp && ip < lastdp + edp) {
1921           if (line) *line = lastline;
1922           if (nlen) *nlen = namelen;
1923           if (nhash) *nhash = namehash;
1924           return filename;
1925         }
1926         lastdp += edp;
1927       }
1928     }
1929   }
1930   if (line) *line = 0;
1931   if (nlen) *nlen = 0;
1932   if (nhash) *nlen = 0;
1933   return NULL;
1934 }
1935
1936
1937 //==========================================================================
1938 //
1939 //  ufoBumpDP
1940 //
1941 //==========================================================================
1942 UFO_FORCE_INLINE void ufoBumpDP (uint32_t delta) {
1943   const uint32_t dpa = ufoImgGetU32(ufoAddrHereDP);
1944   uint32_t dp = ufoImgGetU32(dpa);
1945   if ((dp & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(dp + delta);
1946   dp += delta;
1947   ufoImgPutU32(dpa, dp);
1948 }
1949
1950
1951 //==========================================================================
1952 //
1953 //  ufoImgEmitU8
1954 //
1955 //==========================================================================
1956 UFO_FORCE_INLINE void ufoImgEmitU8 (uint32_t value) {
1957   ufoImgPutU8(UFO_GET_DP(), value);
1958   ufoBumpDP(1);
1959 }
1960
1961
1962 //==========================================================================
1963 //
1964 //  ufoImgEmitU16
1965 //
1966 //==========================================================================
1967 UFO_FORCE_INLINE void ufoImgEmitU16 (uint32_t value) {
1968   ufoImgPutU16(UFO_GET_DP(), value);
1969   ufoBumpDP(2);
1970 }
1971
1972
1973 //==========================================================================
1974 //
1975 //  ufoImgEmitU32
1976 //
1977 //==========================================================================
1978 UFO_FORCE_INLINE void ufoImgEmitU32 (uint32_t value) {
1979   ufoImgPutU32(UFO_GET_DP(), value);
1980   ufoBumpDP(4);
1981 }
1982
1983
1984 //==========================================================================
1985 //
1986 //  ufoImgEmitCFA
1987 //
1988 //==========================================================================
1989 UFO_FORCE_INLINE void ufoImgEmitCFA (uint32_t cfa) {
1990   const uint32_t addr = UFO_GET_DP();
1991   ufoImgPutU32(addr, cfa);
1992   ufoImgPutU32(addr + 4u, 0);
1993   ufoBumpDP(8);
1994 }
1995
1996
1997 #ifdef UFO_FAST_MEM_ACCESS
1998
1999 //==========================================================================
2000 //
2001 //  ufoImgEmitU32_NoInline
2002 //
2003 //  false
2004 //
2005 //==========================================================================
2006 UFO_FORCE_INLINE void ufoImgEmitU32_NoInline (uint32_t value) {
2007   ufoImgPutU32(UFO_GET_DP(), value);
2008   ufoBumpDP(4);
2009 }
2010
2011 #else
2012
2013 //==========================================================================
2014 //
2015 //  ufoImgEmitU32_NoInline
2016 //
2017 //  general
2018 //
2019 //==========================================================================
2020 UFO_DISABLE_INLINE void ufoImgEmitU32_NoInline (uint32_t value) {
2021   ufoImgPutU32(UFO_GET_DP(), value);
2022   ufoBumpDP(4);
2023 }
2024
2025 #endif
2026
2027
2028 //==========================================================================
2029 //
2030 //  ufoImgEmitAlign
2031 //
2032 //==========================================================================
2033 UFO_FORCE_INLINE void ufoImgEmitAlign (void) {
2034   while ((UFO_GET_DP() & 3) != 0) ufoImgEmitU8(0);
2035 }
2036
2037
2038 //==========================================================================
2039 //
2040 //  ufoResetTib
2041 //
2042 //==========================================================================
2043 UFO_FORCE_INLINE void ufoResetTib (void) {
2044   uint32_t defTIB = ufoImgGetU32(ufoAddrDefTIB);
2045   //fprintf(stderr, "ufoResetTib(%p): defTIB=0x%08x\n", ufoCurrState, defTIB);
2046   if (defTIB == 0) {
2047     // create new TIB handle
2048     UfoHandle *tibh = ufoAllocHandle(0x69a029a6); // arbitrary number
2049     defTIB = tibh->ufoHandle;
2050     ufoImgPutU32(ufoAddrDefTIB, defTIB);
2051   }
2052   if ((defTIB & UFO_ADDR_HANDLE_BIT) != 0) {
2053     UfoHandle *hh = ufoGetHandle(defTIB);
2054     if (hh == NULL) ufoFatal("default TIB is not allocated");
2055     if (hh->size == 0) {
2056       ufo_assert(hh->data == NULL);
2057       hh->data = calloc(1, UFO_ADDR_HANDLE_OFS_MASK + 1);
2058       if (hh->data == NULL) ufoFatal("out of memory for default TIB");
2059       hh->size = UFO_ADDR_HANDLE_OFS_MASK + 1;
2060     }
2061   }
2062   const uint32_t oldA = ufoRegA;
2063   ufoImgPutU32(ufoAddrTIBx, defTIB);
2064   ufoImgPutU32(ufoAddrINx, 0);
2065   ufoRegA = defTIB;
2066   ufoPush(0); // value
2067   ufoPush(0); // offset
2068   UFCALL(CPOKE_REGA_IDX);
2069   ufoRegA = oldA;
2070 }
2071
2072
2073 //==========================================================================
2074 //
2075 //  ufoTibEnsureSize
2076 //
2077 //==========================================================================
2078 UFO_DISABLE_INLINE void ufoTibEnsureSize (uint32_t size) {
2079   if (size > 1024u * 1024u * 256u) ufoFatal("TIB size too big");
2080   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
2081   //fprintf(stderr, "ufoTibEnsureSize: TIB=0x%08x; size=%u\n", tib, size);
2082   if ((tib & UFO_ADDR_HANDLE_BIT) != 0) {
2083     UfoHandle *hh = ufoGetHandle(tib);
2084     if (hh == NULL) {
2085       ufoFatal("cannot resize TIB, TIB is not a handle");
2086     }
2087     if (hh->size < size) {
2088       const uint32_t newsz = (size | 0xfffU) + 1u;
2089       uint8_t *nx = realloc(hh->data, newsz);
2090       if (nx == NULL) ufoFatal("out of memory for restored TIB");
2091       hh->data = nx;
2092       hh->size = newsz;
2093     }
2094   }
2095   #if 0
2096   else {
2097     ufoFatal("cannot resize TIB, TIB is not a handle (0x%08x)", tib);
2098   }
2099   #endif
2100 }
2101
2102
2103 //==========================================================================
2104 //
2105 //  ufoTibGetSize
2106 //
2107 //==========================================================================
2108 /*
2109 UFO_DISABLE_INLINE uint32_t ufoTibGetSize (void) {
2110   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
2111   if ((tib & UFO_ADDR_HANDLE_BIT) == 0) {
2112     ufoFatal("cannot query TIB, TIB is not a handle");
2113   }
2114   UfoHandle *hh = ufoGetHandle(tib);
2115   if (hh == NULL) {
2116     ufoFatal("cannot query TIB, TIB is not a handle");
2117   }
2118   return hh->size;
2119 }
2120 */
2121
2122
2123 //==========================================================================
2124 //
2125 //  ufoTibPeekCh
2126 //
2127 //==========================================================================
2128 UFO_FORCE_INLINE uint8_t ufoTibPeekCh (void) {
2129   return (uint8_t)ufoImgGetU8(ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx));
2130 }
2131
2132
2133 //==========================================================================
2134 //
2135 //  ufoTibPeekChOfs
2136 //
2137 //==========================================================================
2138 UFO_FORCE_INLINE uint8_t ufoTibPeekChOfs (uint32_t ofs) {
2139   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
2140   if (ofs <= UFO_ADDR_HANDLE_OFS_MASK || (tib & UFO_ADDR_HANDLE_BIT) == 0) {
2141     return (uint8_t)ufoImgGetU8(tib + ufoImgGetU32(ufoAddrINx) + ofs);
2142   } else {
2143     return 0;
2144   }
2145 }
2146
2147
2148 //==========================================================================
2149 //
2150 //  ufoTibPokeChOfs
2151 //
2152 //==========================================================================
2153 UFO_DISABLE_INLINE void ufoTibPokeChOfs (uint8_t ch, uint32_t ofs) {
2154   const uint32_t oldA = ufoRegA;
2155   ufoRegA = ufoImgGetU32(ufoAddrTIBx);
2156   ufoPush(ch);
2157   ufoPush(ufoImgGetU32(ufoAddrINx) + ofs);
2158   UFCALL(CPOKE_REGA_IDX);
2159   ufoRegA = oldA;
2160 }
2161
2162
2163 //==========================================================================
2164 //
2165 //  ufoTibGetCh
2166 //
2167 //==========================================================================
2168 UFO_FORCE_INLINE uint8_t ufoTibGetCh (void) {
2169   const uint8_t ch = ufoTibPeekCh();
2170   if (ch) ufoImgPutU32(ufoAddrINx, ufoImgGetU32(ufoAddrINx) + 1u);
2171   return ch;
2172 }
2173
2174
2175 //==========================================================================
2176 //
2177 //  ufoTibSkipCh
2178 //
2179 //==========================================================================
2180 UFO_FORCE_INLINE void ufoTibSkipCh (void) {
2181   (void)ufoTibGetCh();
2182 }
2183
2184
2185 // ////////////////////////////////////////////////////////////////////////// //
2186 // native CFA implementations
2187 //
2188
2189 //==========================================================================
2190 //
2191 //  ufoDoForth
2192 //
2193 //==========================================================================
2194 static void ufoDoForth (uint32_t pfa) {
2195   ufoRPush(ufoIP);
2196   ufoIP = pfa;
2197 }
2198
2199
2200 //==========================================================================
2201 //
2202 //  ufoDoVariable
2203 //
2204 //==========================================================================
2205 static void ufoDoVariable (uint32_t pfa) {
2206   ufoPush(pfa);
2207 }
2208
2209
2210 //==========================================================================
2211 //
2212 //  ufoDoUserVariable
2213 //
2214 //==========================================================================
2215 static void ufoDoUserVariable (uint32_t pfa) {
2216   ufoPush(ufoImgGetU32(pfa));
2217 }
2218
2219
2220 //==========================================================================
2221 //
2222 //  ufoDoValue
2223 //
2224 //==========================================================================
2225 static void ufoDoValue (uint32_t pfa) {
2226   ufoPush(ufoImgGetU32(pfa));
2227 }
2228
2229
2230 //==========================================================================
2231 //
2232 //  ufoDoConst
2233 //
2234 //==========================================================================
2235 static void ufoDoConst (uint32_t pfa) {
2236   ufoPush(ufoImgGetU32(pfa));
2237 }
2238
2239
2240 //==========================================================================
2241 //
2242 //  ufoDoDefer
2243 //
2244 //==========================================================================
2245 static void ufoDoDefer (uint32_t pfa) {
2246   pfa = ufoImgGetU32(pfa);
2247   UFO_EXEC_CFA(pfa);
2248 }
2249
2250
2251 //==========================================================================
2252 //
2253 //  ufoDoDoes
2254 //
2255 //==========================================================================
2256 static void ufoDoDoes (uint32_t pfa) {
2257   ufoPush(pfa);
2258   ufoRPush(ufoIP);
2259   ufoIP = ufoImgGetU32(UFO_PFA_TO_DOES_CFA(pfa));
2260 }
2261
2262
2263 //==========================================================================
2264 //
2265 //  ufoDoRedirect
2266 //
2267 //==========================================================================
2268 static void ufoDoRedirect (uint32_t pfa) {
2269   pfa = ufoImgGetU32(UFO_PFA_TO_DOES_CFA(pfa));
2270   UFO_EXEC_CFA(pfa);
2271 }
2272
2273
2274 //==========================================================================
2275 //
2276 //  ufoDoVoc
2277 //
2278 //==========================================================================
2279 static void ufoDoVoc (uint32_t pfa) {
2280   ufoImgPutU32(ufoAddrContext, ufoImgGetU32(pfa));
2281 }
2282
2283
2284 //==========================================================================
2285 //
2286 //  ufoDoCreate
2287 //
2288 //==========================================================================
2289 static void ufoDoCreate (uint32_t pfa) {
2290   ufoPush(pfa);
2291 }
2292
2293
2294 //==========================================================================
2295 //
2296 //  ufoPushInFile
2297 //
2298 //  this also increments last used file id
2299 //
2300 //==========================================================================
2301 static void ufoPushInFile (void) {
2302   if (ufoFileStackPos >= UFO_MAX_NESTED_INCLUDES) ufoFatal("too many includes");
2303   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
2304   stk->fl = ufoInFile;
2305   stk->fname = ufoInFileName;
2306   stk->fline = ufoInFileLine;
2307   stk->id = ufoFileId;
2308   stk->incpath = (ufoLastIncPath ? strdup(ufoLastIncPath) : NULL);
2309   stk->sysincpath = (ufoLastSysIncPath ? strdup(ufoLastSysIncPath) : NULL);
2310   ufoFileStackPos += 1;
2311   ufoInFile = NULL;
2312   ufoInFileName = NULL; ufoInFileNameLen = 0; ufoInFileNameHash = 0;
2313   ufoInFileLine = 0;
2314   ufoLastUsedFileId += 1;
2315   ufo_assert(ufoLastUsedFileId != 0); // just in case ;-)
2316   //ufoLastIncPath = NULL;
2317 }
2318
2319
2320 //==========================================================================
2321 //
2322 //  ufoWipeIncludeStack
2323 //
2324 //==========================================================================
2325 static void ufoWipeIncludeStack (void) {
2326   if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
2327   if (ufoInFile) { fclose(ufoInFile); ufoInFile = NULL; }
2328   if (ufoLastIncPath) { free(ufoLastIncPath); ufoLastIncPath = NULL; }
2329   if (ufoLastSysIncPath) { free(ufoLastSysIncPath); ufoLastSysIncPath = NULL; }
2330   while (ufoFileStackPos != 0) {
2331     ufoFileStackPos -= 1;
2332     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
2333     if (stk->fl) fclose(stk->fl);
2334     if (stk->fname) free(stk->fname);
2335     if (stk->incpath) free(stk->incpath);
2336   }
2337 }
2338
2339
2340 //==========================================================================
2341 //
2342 //  ufoPopInFile
2343 //
2344 //==========================================================================
2345 static void ufoPopInFile (void) {
2346   if (ufoFileStackPos == 0) ufoFatal("trying to pop include from empty stack");
2347   if (ufoInFileName) { free(ufoInFileName); ufoInFileName = NULL; }
2348   if (ufoInFile) { fclose(ufoInFile); ufoInFile = NULL; }
2349   if (ufoLastIncPath) { free(ufoLastIncPath); ufoLastIncPath = NULL; }
2350   if (ufoLastSysIncPath) { free(ufoLastSysIncPath); ufoLastSysIncPath = NULL; }
2351   ufoFileStackPos -= 1;
2352   UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos];
2353   ufoInFile = stk->fl;
2354   ufoSetInFileNameReuse(stk->fname);
2355   ufoInFileLine = stk->fline;
2356   ufoLastIncPath = stk->incpath;
2357   ufoLastSysIncPath = stk->sysincpath;
2358   ufoFileId = stk->id;
2359   ufoResetTib();
2360   #ifdef UFO_DEBUG_INCLUDE
2361   if (ufoInFileName == NULL) {
2362     fprintf(stderr, "INC-POP: no more files.\n");
2363   } else {
2364     fprintf(stderr, "INC-POP: fname: %s\n", ufoInFileName);
2365   }
2366   #endif
2367 }
2368
2369
2370 //==========================================================================
2371 //
2372 //  ufoDeinit
2373 //
2374 //==========================================================================
2375 void ufoDeinit (void) {
2376   #ifdef UFO_DEBUG_WRITE_MAIN_IMAGE
2377   {
2378     FILE *fo = fopen("zufo_main.img", "w");
2379     const uint32_t dpMain = ufoImgGetU32(ufoAddrDP);
2380     fwrite(ufoImage, dpMain, 1, fo);
2381     fclose(fo);
2382   }
2383   #endif
2384
2385   #ifdef UFO_DEBUG_WRITE_DEBUG_IMAGE
2386   {
2387     FILE *fo = fopen("zufo_debug.img", "w");
2388     fwrite(ufoDebugImage, ufoDebugImageUsed, 1, fo);
2389     fclose(fo);
2390   }
2391   #endif
2392
2393   #ifdef UFO_DEBUG_DEBUG
2394   {
2395     const uint32_t dpMain = ufoImgGetU32(ufoAddrDP);
2396     fprintf(stderr, "UFO: image used: %u; size: %u\n", dpMain, ufoImageSize);
2397     fprintf(stderr, "UFO: debug image used: %u; size: %u\n", ufoDebugImageUsed, ufoDebugImageSize);
2398     ufoDumpDebugImage();
2399   }
2400   #endif
2401
2402   // free all states
2403   #ifdef UFO_MTASK_ALLOWED
2404   ufoCurrState = NULL;
2405   ufoYieldedState = NULL;
2406   ufoDebuggerState = NULL;
2407   for (uint32_t fidx = 0; fidx < (uint32_t)(UFO_MAX_STATES/32); fidx += 1u) {
2408     uint32_t bmp = ufoStateUsedBitmap[fidx];
2409     if (bmp != 0) {
2410       uint32_t stid = fidx * 32u;
2411       while (bmp != 0) {
2412         if ((bmp & 0x01) != 0) ufoFreeState(ufoStateMap[stid]);
2413         stid += 1u; bmp >>= 1;
2414       }
2415     }
2416   }
2417   #endif
2418
2419   free(ufoDebugImage);
2420   ufoDebugImage = NULL;
2421   ufoDebugImageUsed = 0;
2422   ufoDebugImageSize = 0;
2423   ufoDebugFileNameHash = 0;
2424   ufoDebugFileNameLen = 0;
2425   ufoDebugLastLine = 0;
2426   ufoDebugLastLinePCOfs = 0;
2427   ufoDebugLastLineDP = 0;
2428   ufoDebugCurrDP = 0;
2429
2430   ufoInBacktrace = 0;
2431   ufoClearCondDefines();
2432   ufoWipeIncludeStack();
2433
2434   // release all includes
2435   ufoInFile = NULL;
2436   if (ufoInFileName) free(ufoInFileName);
2437   if (ufoLastIncPath) free(ufoLastIncPath);
2438   if (ufoLastSysIncPath) free(ufoLastSysIncPath);
2439   ufoInFileName = NULL; ufoLastIncPath = NULL; ufoLastSysIncPath = NULL;
2440   ufoInFileNameHash = 0; ufoInFileNameLen = 0;
2441   ufoInFileLine = 0;
2442
2443   //free(ufoForthCFAs);
2444   //ufoForthCFAs = NULL;
2445   ufoCFAsUsed = 0;
2446
2447   #ifndef UFO_HUGE_IMAGES
2448   free(ufoImage);
2449   ufoImage = NULL;
2450   ufoImageSize = 0;
2451   #endif
2452
2453   ufoMode = UFO_MODE_NATIVE;
2454   ufoForthVocId = 0; ufoCompilerVocId = 0;
2455   #ifdef UFO_MTASK_ALLOWED
2456   ufoSingleStep = 0;
2457   #endif
2458
2459   // free all handles
2460   for (uint32_t f = 0; f < ufoHandlesUsed; f += 1) {
2461     UfoHandle *hh = ufoHandles[f];
2462     if (hh != NULL) {
2463       if (hh->data != NULL) free(hh->data);
2464       free(hh);
2465     }
2466   }
2467   if (ufoHandles != NULL) free(ufoHandles);
2468   ufoHandles = NULL; ufoHandlesUsed = 0; ufoHandlesAlloted = 0;
2469   ufoHandleFreeList = NULL;
2470
2471   ufoLastEmitWasCR = 1;
2472
2473   ufoClearCondDefines();
2474 }
2475
2476
2477 //==========================================================================
2478 //
2479 //  ufoDumpWordHeader
2480 //
2481 //==========================================================================
2482 __attribute__((unused)) static void ufoDumpWordHeader (const uint32_t lfa) {
2483   fprintf(stderr, "=== WORD: LFA: 0x%08x ===\n", lfa);
2484   if (lfa != 0) {
2485     fprintf(stderr, "  (XFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_XFA(lfa)));
2486     fprintf(stderr, "  (YFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_YFA(lfa)));
2487     fprintf(stderr, "  (BFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_BFA(lfa)));
2488     fprintf(stderr, "  (LFA): 0x%08x\n", ufoImgGetU32(lfa));
2489     fprintf(stderr, "  (NHH): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)));
2490     const uint32_t cfa = UFO_LFA_TO_CFA(lfa);
2491     fprintf(stderr, "    CFA: 0x%08x\n", cfa);
2492     fprintf(stderr, "    PFA: 0x%08x\n", UFO_CFA_TO_PFA(cfa));
2493     fprintf(stderr, "  (CFA): 0x%08x\n", ufoImgGetU32(cfa));
2494     const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
2495     const uint32_t nlen = ufoImgGetU8(nfa);
2496     fprintf(stderr, "    NFA: 0x%08x  (nlen: %u)\n", nfa, nlen);
2497     const uint32_t flags = ufoImgGetU32(nfa);
2498     fprintf(stderr, "  FLAGS: 0x%08x\n", flags);
2499     if ((flags & 0xffff0000U) != 0) {
2500       fprintf(stderr, "  FLAGS:");
2501       if (flags & UFW_FLAG_IMMEDIATE) fprintf(stderr, " IMM");
2502       if (flags & UFW_FLAG_SMUDGE) fprintf(stderr, " SMUDGE");
2503       if (flags & UFW_FLAG_NORETURN) fprintf(stderr, " NORET");
2504       if (flags & UFW_FLAG_HIDDEN) fprintf(stderr, " HIDDEN");
2505       if (flags & UFW_FLAG_CBLOCK) fprintf(stderr, " CBLOCK");
2506       if (flags & UFW_FLAG_VOCAB) fprintf(stderr, " VOCAB");
2507       if (flags & UFW_FLAG_SCOLON) fprintf(stderr, " SCOLON");
2508       if (flags & UFW_FLAG_PROTECTED) fprintf(stderr, " PROTECTED");
2509       fputc('\n', stderr);
2510     }
2511     if ((flags & 0xff00U) != 0) {
2512       fprintf(stderr, "   ARGS: ");
2513       switch (flags & UFW_WARG_MASK) {
2514         case UFW_WARG_NONE: fprintf(stderr, "NONE"); break;
2515         case UFW_WARG_BRANCH: fprintf(stderr, "BRANCH"); break;
2516         case UFW_WARG_LIT: fprintf(stderr, "LIT"); break;
2517         case UFW_WARG_C4STRZ: fprintf(stderr, "C4STRZ"); break;
2518         case UFW_WARG_CFA: fprintf(stderr, "CFA"); break;
2519         case UFW_WARG_CBLOCK: fprintf(stderr, "CBLOCK"); break;
2520         case UFW_WARG_VOCID: fprintf(stderr, "VOCID"); break;
2521         case UFW_WARG_C1STRZ: fprintf(stderr, "C1STRZ"); break;
2522         case UFW_WARG_DATASKIP: fprintf(stderr, "DATA"); break;
2523         case UFW_WARG_PFA: fprintf(stderr, "PFA"); break;
2524         default: fprintf(stderr, "wtf?!"); break;
2525       }
2526       fputc('\n', stderr);
2527     }
2528     fprintf(stderr, "  BACKLEN: %u (nfa at 0x%08x)\n", ufoImgGetU8(cfa - 1u), UFO_CFA_TO_NFA(cfa));
2529     fprintf(stderr, "  NAME(%u): ", nlen);
2530     for (uint32_t f = 0; f < nlen; f += 1) {
2531       const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2532       if (ch <= 32 || ch >= 127) {
2533         fprintf(stderr, "\\x%02x", ch);
2534       } else {
2535         fprintf(stderr, "%c", (char)ch);
2536       }
2537     }
2538     fprintf(stderr, "\n");
2539     ufo_assert(UFO_CFA_TO_LFA(cfa) == lfa);
2540   }
2541 }
2542
2543
2544 //==========================================================================
2545 //
2546 //  ufoVocCheckName
2547 //
2548 //  return 0 or CFA
2549 //
2550 //==========================================================================
2551 static uint32_t ufoVocCheckName (uint32_t lfa, const void *wname, uint32_t wnlen, uint32_t hash,
2552                                  int allowvochid)
2553 {
2554   uint32_t res = 0;
2555   #ifdef UFO_DEBUG_FIND_WORD
2556   fprintf(stderr, "CHECK-NAME: %.*s; LFA: 0x%08x; hash: 0x%08x (wname: 0x%08x)\n",
2557           (unsigned) wnlen, (const char *)wname,
2558           lfa, (lfa != 0 ? ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)) : 0), hash);
2559   ufoDumpWordHeader(lfa);
2560   #endif
2561   if (lfa != 0 && ufoImgGetU32(UFO_LFA_TO_NHASH(lfa)) == hash) {
2562     const uint32_t lenflags = ufoImgGetU32(UFO_LFA_TO_NFA(lfa));
2563     if ((lenflags & UFW_FLAG_SMUDGE) == 0 &&
2564         (allowvochid || (lenflags & UFW_FLAG_HIDDEN) == 0))
2565     {
2566       const uint32_t nlen = lenflags&0xffU;
2567       if (nlen == wnlen) {
2568         uint32_t naddr = UFO_LFA_TO_NFA(lfa) + 4u;
2569         uint32_t pos = 0;
2570         while (pos < nlen) {
2571           uint8_t c0 = ((const unsigned char *)wname)[pos];
2572           if (c0 >= 'a' && c0 <= 'z') c0 = c0 - 'a' + 'A';
2573           uint8_t c1 = ufoImgGetU8(naddr + pos);
2574           if (c1 >= 'a' && c1 <= 'z') c1 = c1 - 'a' + 'A';
2575           if (c0 != c1) break;
2576           pos += 1u;
2577         }
2578         if (pos == nlen) {
2579           // i found her!
2580           naddr += pos + 1u;
2581           res = UFO_ALIGN4(naddr);
2582         }
2583       }
2584     }
2585   }
2586   return res;
2587 }
2588
2589
2590 //==========================================================================
2591 //
2592 //  ufoFindWordInVoc
2593 //
2594 //  return 0 or CFA
2595 //
2596 //==========================================================================
2597 static uint32_t ufoFindWordInVoc (const void *wname, uint32_t wnlen, uint32_t hash,
2598                                   uint32_t vocid, int allowvochid)
2599 {
2600   uint32_t res = 0;
2601   if (wname == NULL) ufo_assert(wnlen == 0);
2602   if (wnlen != 0 && vocid != 0) {
2603     if (hash == 0) hash = joaatHashBufCI(wname, wnlen);
2604     #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
2605     fprintf(stderr, "IN-VOC: %.*s; VOCID: 0x%08x; whash: 0x%08x; htbl[0]: 0x%08x\n",
2606             (unsigned) wnlen, (const char *)wname,
2607             vocid, hash, ufoImgGetU32(vocid + UFW_VOCAB_OFS_HTABLE));
2608     #endif
2609     const uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
2610     if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
2611       // hash table present, use it
2612       uint32_t bfa = htbl + (hash % (uint32_t)UFO_HASHTABLE_SIZE) * 4u;
2613       bfa = ufoImgGetU32(bfa);
2614       while (res == 0 && bfa != 0) {
2615         #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
2616         fprintf(stderr, "IN-VOC:   bfa: 0x%08x\n", bfa);
2617         #endif
2618         res = ufoVocCheckName(UFO_BFA_TO_LFA(bfa), wname, wnlen, hash, allowvochid);
2619         bfa = ufoImgGetU32(bfa);
2620       }
2621     } else {
2622       // no hash table, use linear search
2623       uint32_t lfa = vocid + UFW_VOCAB_OFS_LATEST;
2624       lfa = ufoImgGetU32(lfa);
2625       while (res == 0 && lfa != 0) {
2626         res = ufoVocCheckName(lfa, wname, wnlen, hash, allowvochid);
2627         lfa = ufoImgGetU32(lfa);
2628       }
2629     }
2630   }
2631   return res;
2632 }
2633
2634
2635 //==========================================================================
2636 //
2637 //  ufoFindColon
2638 //
2639 //  return part after the colon, or `NULL`
2640 //
2641 //==========================================================================
2642 static const void *ufoFindColon (const void *wname, uint32_t wnlen) {
2643   const void *res = NULL;
2644   if (wnlen != 0) {
2645     ufo_assert(wname != NULL);
2646     const char *str = (const char *)wname;
2647     while (wnlen != 0 && str[0] != ':') {
2648       str += 1; wnlen -= 1;
2649     }
2650     if (wnlen != 0) {
2651       res = (const void *)(str + 1); // skip colon
2652     }
2653   }
2654   return res;
2655 }
2656
2657
2658 //==========================================================================
2659 //
2660 //  ufoFindWordInVocAndParents
2661 //
2662 //==========================================================================
2663 static uint32_t ufoFindWordInVocAndParents (const void *wname, uint32_t wnlen, uint32_t hash,
2664                                             uint32_t vocid, int allowvochid)
2665 {
2666   uint32_t res = 0;
2667   if (hash == 0) hash = joaatHashBufCI(wname, wnlen);
2668   while (res == 0 && vocid != 0) {
2669     res = ufoFindWordInVoc(wname, wnlen, hash, vocid, allowvochid);
2670     vocid = ufoImgGetU32(vocid + UFW_VOCAB_OFS_PARENT);
2671   }
2672   return res;
2673 }
2674
2675
2676 //==========================================================================
2677 //
2678 //  ufoFindWordNameRes
2679 //
2680 //  find with name resolution
2681 //
2682 //  return 0 or CFA
2683 //
2684 //==========================================================================
2685 static uint32_t ufoFindWordNameRes (const void *wname, uint32_t wnlen) {
2686   uint32_t res = 0;
2687   if (wnlen != 0 && *(const char *)wname != ':') {
2688     ufo_assert(wname != NULL);
2689
2690     const void *stx = wname;
2691     wname = ufoFindColon(wname, wnlen);
2692     if (wname != NULL && wname != stx + wnlen) {
2693       // look in all vocabs (excluding hidden ones)
2694       uint32_t xlen = (uint32_t)(ptrdiff_t)(wname - stx) - 1u;
2695       ufo_assert(xlen > 0 && xlen < 255);
2696       uint32_t xhash = joaatHashBufCI(stx, xlen);
2697       uint32_t voclink = ufoImgGetU32(ufoAddrVocLink);
2698       #ifdef UFO_DEBUG_FIND_WORD_COLON
2699       fprintf(stderr, "COLON-FIND: first voc: {%.*s}; xhash=0x%08x; voc-link: 0x%08x\n",
2700               (unsigned)xlen, (const char *)stx, xhash, voclink);
2701       #endif
2702       while (res == 0 && voclink != 0) {
2703         const uint32_t vhdraddr = voclink - UFW_VOCAB_OFS_VOCLINK + UFW_VOCAB_OFS_HEADER;
2704         const uint32_t vhdr = ufoImgGetU32(vhdraddr);
2705         if (vhdr != 0) {
2706           res = ufoVocCheckName(UFO_NFA_TO_LFA(vhdr), stx, xlen, xhash, 0);
2707         }
2708         if (res == 0) voclink = ufoImgGetU32(voclink);
2709       }
2710       if (res != 0) {
2711         uint32_t vocid = voclink - UFW_VOCAB_OFS_VOCLINK;
2712         ufo_assert(voclink != 0);
2713         wnlen -= xlen + 1;
2714         #ifdef UFO_DEBUG_FIND_WORD_COLON
2715         fprintf(stderr, "searching {%.*s}(%u) in {%.*s}\n",
2716                 (unsigned)wnlen, wname, wnlen, (unsigned)xlen, stx);
2717         #endif
2718         while (res != 0 && wname != NULL) {
2719           // first, the whole rest
2720           res = ufoFindWordInVocAndParents(wname, wnlen, 0, vocid, 1);
2721           if (res != 0) {
2722             wname = NULL;
2723           } else {
2724             stx = wname;
2725             wname = ufoFindColon(wname, wnlen);
2726             if (wname == NULL) xlen = wnlen; else xlen = (uint32_t)(ptrdiff_t)(wname - stx) - 1u;
2727             ufo_assert(xlen > 0 && xlen < 255);
2728             res = ufoFindWordInVocAndParents(stx, xlen, 0, vocid, 1);
2729             if (res != 0) {
2730               wnlen -= xlen + 1;
2731               if (wname != NULL) {
2732                 // it should be a vocabulary
2733                 const uint32_t nfa = UFO_CFA_TO_NFA(res);
2734                 if ((ufoImgGetU32(nfa) & UFW_FLAG_VOCAB) != 0) {
2735                   vocid = ufoImgGetU32(UFO_CFA_TO_PFA(res)); // pfa points to vocabulary
2736                 } else {
2737                   res = 0;
2738                 }
2739               }
2740             }
2741           }
2742         }
2743       }
2744     }
2745   }
2746
2747   return res;
2748 }
2749
2750
2751 //==========================================================================
2752 //
2753 //  ufoFindWord
2754 //
2755 //  doesn't look in CURRENT, does name resolution ("a:b" is word "b" in "a")
2756 //
2757 //  return 0 or CFA
2758 //
2759 //==========================================================================
2760 static uint32_t ufoFindWord (const char *wname) {
2761   uint32_t res = 0;
2762   if (wname && wname[0] != 0) {
2763     const size_t wnlen = strlen(wname);
2764     ufo_assert(wnlen < 8192);
2765     uint32_t ctx = ufoImgGetU32(ufoAddrContext);
2766     const uint32_t hash = joaatHashBufCI(wname, (uint32_t)wnlen);
2767
2768     //fprintf(stderr, "FIND-WORD: whash: 0x%08x; name:{%s}\n", hash, wname);
2769
2770     // first search in context
2771     res = ufoFindWordInVocAndParents(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
2772
2773     // now try vocabulary stack
2774     uint32_t vstp = ufoVSP;
2775     while (res == 0 && vstp != 0) {
2776       vstp -= 1;
2777       ctx = ufoVocStack[vstp];
2778       res = ufoFindWordInVocAndParents(wname, (uint32_t)wnlen, hash, ctx, (ctx == ufoImgGetU32(ufoAddrCurrent)));
2779     }
2780
2781     // if not found, try name resolution
2782     if (res == 0) res = ufoFindWordNameRes(wname, (uint32_t)wnlen);
2783   }
2784
2785   return res;
2786 }
2787
2788
2789 //==========================================================================
2790 //
2791 //  ufoCreateWordHeader
2792 //
2793 //  create word header up to CFA, link to the current dictionary
2794 //
2795 //==========================================================================
2796 static void ufoCreateWordHeader (const char *wname, uint32_t flags) {
2797   if (wname == NULL) wname = "";
2798   const size_t wnlen = strlen(wname);
2799   ufo_assert(wnlen < UFO_MAX_WORD_LENGTH);
2800   const uint32_t hash = joaatHashBufCI(wname, (uint32_t)wnlen);
2801   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
2802   ufo_assert(curr != 0);
2803
2804   // redefine check
2805   const uint32_t warn = ufoImgGetU32(ufoAddrRedefineWarning);
2806   if (wnlen != 0 && warn != UFO_REDEF_WARN_DONT_CARE) {
2807     uint32_t cfa;
2808     if (warn != UFO_REDEF_WARN_PARENTS) {
2809       cfa = ufoFindWordInVoc(wname, wnlen, hash, curr, 1);
2810     } else {
2811       cfa = ufoFindWordInVocAndParents(wname, wnlen, hash, curr, 1);
2812     }
2813     if (cfa != 0) {
2814       const uint32_t nfa = UFO_CFA_TO_NFA(cfa);
2815       const uint32_t flags = ufoImgGetU32(nfa);
2816       if ((flags & UFW_FLAG_PROTECTED) != 0) {
2817         ufoFatal("trying to redefine protected word '%s'", wname);
2818       } else if (warn != UFO_REDEF_WARN_NONE) {
2819         ufoWarning("redefining word '%s'", wname);
2820       }
2821     }
2822   }
2823
2824   const uint32_t bkt = (hash % (uint32_t)UFO_HASHTABLE_SIZE) * 4u;
2825   const uint32_t htbl = curr + UFW_VOCAB_OFS_HTABLE;
2826
2827   ufoImgEmitAlign();
2828   const uint32_t xfaAddr = UFO_GET_DP();
2829   if ((xfaAddr & UFO_ADDR_TEMP_BIT) == 0) {
2830     // link previous yfa here
2831     const uint32_t lastxfa = ufoImgGetU32(ufoAddrLastXFA);
2832     // fix YFA of the previous word (it points to our YFA)
2833     if (lastxfa != 0) {
2834       ufoImgPutU32(UFO_XFA_TO_YFA(lastxfa), UFO_XFA_TO_YFA(xfaAddr));
2835     }
2836     // our XFA points to the previous XFA
2837     ufoImgEmitU32(lastxfa); // xfa
2838     // update last XFA
2839     ufoImgPutU32(ufoAddrLastXFA, xfaAddr);
2840   } else {
2841     ufoImgEmitU32(0); // xfa
2842   }
2843   ufoImgEmitU32(0); // yfa
2844
2845   // bucket link (bfa)
2846   if (wnlen == 0 || ufoImgGetU32(htbl) == UFO_NO_HTABLE_FLAG) {
2847     ufoImgEmitU32(0);
2848   } else {
2849     #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
2850     fprintf(stderr, "NEW HEADER: %s; curr: 0x%08x; htbl: 0x%08x; bkt: 0x%08x\n",
2851             wname, curr, htbl, bkt);
2852     fprintf(stderr, "  [bkt]: 0x%08x; nbk: 0x%08x\n", ufoImgGetU32(htbl + bkt), UFO_GET_DP());
2853     #endif
2854     // bfa points to bfa
2855     const uint32_t bfa = UFO_GET_DP();
2856     ufoImgEmitU32(ufoImgGetU32(htbl + bkt));
2857     ufoImgPutU32(htbl + bkt, bfa);
2858   }
2859
2860   // lfa
2861   const uint32_t lfa = UFO_GET_DP();
2862   ufoImgEmitU32(ufoImgGetU32(curr + UFW_VOCAB_OFS_LATEST));
2863   // fix voc latest
2864   ufoImgPutU32(curr + UFW_VOCAB_OFS_LATEST, lfa);
2865   // name hash
2866   ufoImgEmitU32(hash);
2867   // name length
2868   const uint32_t nfa = UFO_GET_DP();
2869   ufoImgEmitU32(((uint32_t)wnlen&0xffU) | (flags & 0xffffff00U));
2870   const uint32_t nstart = UFO_GET_DP();
2871   // put name
2872   for (size_t f = 0; f < wnlen; f += 1) {
2873     ufoImgEmitU8(((const unsigned char *)wname)[f]);
2874   }
2875   while ((UFO_GET_DP() & 3) != 3) ufoImgEmitU8(0);
2876   const uint32_t nend = UFO_GET_DP(); // length byte itself is not included
2877   // name length, again
2878   ufo_assert(nend - nstart <= 255);
2879   ufoImgEmitU8((uint8_t)(nend - nstart));
2880   ufo_assert((UFO_GET_DP() & 3) == 0);
2881   ufo_assert(UFO_CFA_TO_NFA(UFO_GET_DP()) == nfa);
2882   if ((nend & UFO_ADDR_SPECIAL_BITS_MASK) == 0) ufoRecordDebug(nend);
2883   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
2884   fprintf(stderr, "*** NEW HEADER ***\n");
2885   fprintf(stderr, "CFA: 0x%08x\n", UFO_GET_DP());
2886   fprintf(stderr, "NSTART: 0x%08x\n", nstart);
2887   fprintf(stderr, "NEND: 0x%08x\n", nend);
2888   fprintf(stderr, "NLEN: %u (%u)\n", nend - nstart, ufoImgGetU8(UFO_GET_DP() - 1u));
2889   ufoDumpWordHeader(lfa);
2890   #endif
2891   #if 0
2892   fprintf(stderr, "NEW WORD CFA 0x%08x: %s\n", UFO_GET_DP(), wname);
2893   #endif
2894 }
2895
2896
2897 //==========================================================================
2898 //
2899 //  ufoDecompilePart
2900 //
2901 //==========================================================================
2902 static void ufoDecompilePart (uint32_t addr, uint32_t eaddr, int indent) {
2903   uint32_t count;
2904   FILE *fo = stdout;
2905   while (addr < eaddr) {
2906     uint32_t cfa = ufoImgGetU32(addr);
2907     for (int n = 0; n < indent; n += 1) fputc(' ', fo);
2908     fprintf(fo, "%6u: 0x%08x: ", addr, cfa);
2909     uint32_t nfa = UFO_CFA_TO_NFA(cfa);
2910     uint32_t flags = ufoImgGetU32(nfa);
2911     //fprintf(fo, "[0x%08x] ", flags & UFW_WARG_MASK);
2912     uint32_t nlen = flags & 0xffU;
2913     for (uint32_t f = 0; f < nlen; f += 1) {
2914       const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2915       if (ch <= 32 || ch >= 127) {
2916         fprintf(fo, "\\x%02x", ch);
2917       } else {
2918         fprintf(fo, "%c", (char)ch);
2919       }
2920     }
2921     addr += 4u;
2922     switch (flags & UFW_WARG_MASK) {
2923       case UFW_WARG_NONE:
2924         break;
2925       case UFW_WARG_BRANCH:
2926         #ifdef UFO_RELATIVE_BRANCH
2927         fprintf(fo, "  @%u", addr + ufoImgGetU32(addr)); addr += 4u;
2928         #else
2929         fprintf(fo, "  @%u", ufoImgGetU32(addr)); addr += 4u;
2930         #endif
2931         break;
2932       case UFW_WARG_LIT:
2933         fprintf(fo, "  %u : %d : 0x%08x", ufoImgGetU32(addr),
2934                 (int32_t)ufoImgGetU32(addr), ufoImgGetU32(addr)); addr += 4u;
2935         break;
2936       case UFW_WARG_C4STRZ:
2937         count = ufoImgGetU32(addr); addr += 4;
2938        print_str:
2939         fprintf(fo, "  str:");
2940         for (int f = 0; f < count; f += 1) {
2941           const uint8_t ch = ufoImgGetU8(addr); addr += 1u;
2942           if (ch <= 32 || ch >= 127) {
2943             fprintf(fo, "\\x%02x", ch);
2944           } else {
2945             fprintf(fo, "%c", (char)ch);
2946           }
2947         }
2948         addr += 1u; // skip zero byte
2949         addr = UFO_ALIGN4(addr);
2950         break;
2951       case UFW_WARG_CFA:
2952         cfa = ufoImgGetU32(addr); addr += 4u;
2953         fprintf(fo, "  CFA:%u: ", cfa);
2954         nfa = UFO_CFA_TO_NFA(cfa);
2955         nlen = ufoImgGetU8(nfa);
2956         for (uint32_t f = 0; f < nlen; f += 1) {
2957           const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2958           if (ch <= 32 || ch >= 127) {
2959             fprintf(fo, "\\x%02x", ch);
2960           } else {
2961             fprintf(fo, "%c", (char)ch);
2962           }
2963         }
2964         break;
2965       case UFW_WARG_PFA:
2966         cfa = ufoImgGetU32(addr); addr += 4u;
2967         fprintf(fo, "  PFA:%u: ", cfa);
2968         cfa = UFO_PFA_TO_CFA(cfa);
2969         nfa = UFO_CFA_TO_NFA(cfa);
2970         nlen = ufoImgGetU8(nfa);
2971         for (uint32_t f = 0; f < nlen; f += 1) {
2972           const uint8_t ch = ufoImgGetU8(nfa + 4u + f);
2973           if (ch <= 32 || ch >= 127) {
2974             fprintf(fo, "\\x%02x", ch);
2975           } else {
2976             fprintf(fo, "%c", (char)ch);
2977           }
2978         }
2979         break;
2980       case UFW_WARG_CBLOCK:
2981         fprintf(fo, "  CBLOCK:%u", ufoImgGetU32(addr)); addr += 4u;
2982         break;
2983       case UFW_WARG_VOCID:
2984         fprintf(fo, "  VOCID:%u", ufoImgGetU32(addr)); addr += 4u;
2985         break;
2986       case UFW_WARG_C1STRZ:
2987         count = ufoImgGetU8(addr); addr += 1;
2988         goto print_str;
2989       case UFW_WARG_DATASKIP:
2990         fprintf(fo, "  DATA:%u", ufoImgGetU32(addr));
2991         addr += UFO_ALIGN4(4u + ufoImgGetU32(addr));
2992         break;
2993       default:
2994         fprintf(fo, " -- WTF?!\n");
2995         abort();
2996     }
2997     fputc('\n', fo);
2998   }
2999 }
3000
3001
3002 //==========================================================================
3003 //
3004 //  ufoDecompileWord
3005 //
3006 //==========================================================================
3007 static void ufoDecompileWord (const uint32_t cfa) {
3008   if (cfa != 0) {
3009     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
3010     fprintf(stdout, "#### DECOMPILING CFA %u ###\n", cfa);
3011     ufoDumpWordHeader(lfa);
3012     const uint32_t yfa = ufoGetWordEndAddr(cfa);
3013     if (ufoImgGetU32(cfa) == ufoDoForthCFA) {
3014       fprintf(stdout, "--- DECOMPILED CODE ---\n");
3015       ufoDecompilePart(UFO_CFA_TO_PFA(cfa), yfa, 0);
3016       fprintf(stdout, "=======================\n");
3017     }
3018   }
3019 }
3020
3021
3022 //==========================================================================
3023 //
3024 //  ufoBTShowWordName
3025 //
3026 //==========================================================================
3027 static void ufoBTShowWordName (uint32_t nfa) {
3028   if (nfa != 0) {
3029     uint32_t len = ufoImgGetU8(nfa); nfa += 4u;
3030     //fprintf(stderr, "(0x%08x)", ufoImgGetU32(nfa - 4u));
3031     while (len != 0) {
3032       uint8_t ch = ufoImgGetU8(nfa); nfa += 1u; len -= 1u;
3033       if (ch <= 32 || ch >= 127) {
3034         fprintf(stderr, "\\x%02x", ch);
3035       } else {
3036         fprintf(stderr, "%c", (char)ch);
3037       }
3038     }
3039   }
3040 }
3041
3042
3043 //==========================================================================
3044 //
3045 //  ufoBacktrace
3046 //
3047 //==========================================================================
3048 static void ufoBacktrace (uint32_t ip, int showDataStack) {
3049   // dump data stack (top 16)
3050   ufoFlushOutput();
3051   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3052
3053   if (showDataStack) {
3054     fprintf(stderr, "***UFO STACK DEPTH: %u\n", ufoSP);
3055     uint32_t xsp = ufoSP;
3056     if (xsp > 16) xsp = 16;
3057     for (uint32_t sp = 0; sp < xsp; ++sp) {
3058       fprintf(stderr, "  %2u: 0x%08x  %d%s\n",
3059               sp, ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1],
3060               (sp == 0 ? " -- TOS" : ""));
3061     }
3062     if (ufoSP > 16) fprintf(stderr, "    ...more...\n");
3063   }
3064
3065   // dump return stack (top 32)
3066   uint32_t nfa;
3067   uint32_t fline;
3068   const char *fname;
3069
3070   fprintf(stderr, "***UFO RETURN STACK DEPTH: %u\n", ufoRP);
3071   if (ip != 0) {
3072     nfa = ufoFindWordForIP(ip);
3073     if (nfa != 0) {
3074       fprintf(stderr, "  **: %8u -- ", ip);
3075       ufoBTShowWordName(nfa);
3076       fname = ufoFindFileForIP(ip, &fline, NULL, NULL);
3077       if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }
3078       fputc('\n', stderr);
3079     }
3080   }
3081   uint32_t rp = ufoRP;
3082   uint32_t rscount = 0;
3083   if (rp > UFO_RSTACK_SIZE) rp = UFO_RSTACK_SIZE;
3084   while (rscount != 32 && rp != 0) {
3085     rp -= 1;
3086     const uint32_t val = ufoRStack[rp];
3087     nfa = ufoFindWordForIP(val - 4u);
3088     if (nfa != 0) {
3089       fprintf(stderr, "  %2u: %8u -- ", ufoRP - rp - 1u, val);
3090       ufoBTShowWordName(nfa);
3091       fname = ufoFindFileForIP(val - 4u, &fline, NULL, NULL);
3092       if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }
3093       fputc('\n', stderr);
3094     } else {
3095       fprintf(stderr, "  %2u: 0x%08x  %d\n", ufoRP - rp - 1u, val, (int32_t)val);
3096     }
3097     rscount += 1;
3098   }
3099   if (ufoRP > 32) fprintf(stderr, "    ...more...\n");
3100
3101   ufoFlushOutput();
3102 }
3103
3104
3105 //==========================================================================
3106 //
3107 //  ufoDumpVocab
3108 //
3109 //==========================================================================
3110 /*
3111 static void ufoDumpVocab (uint32_t vocid) {
3112   if (vocid != 0) {
3113     fprintf(stderr, "*** VOCID: 0x%08x ***\n", vocid);
3114     uint32_t vochdr = vocid + UFW_VOCAB_OFS_HEADER;
3115     vochdr = ufoImgGetU32(vochdr);
3116     if (vochdr != 0) {
3117       fprintf(stderr, "--- HEADER ---\n");
3118       ufoDumpWordHeader(UFO_NFA_TO_LFA(vochdr));
3119       fprintf(stderr, "========\n");
3120       uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
3121       if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
3122         fprintf(stderr, "--- HASH TABLE ---\n");
3123         for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) {
3124           uint32_t bfa = ufoImgGetU32(htbl);
3125           if (bfa != 0) {
3126             fprintf(stderr, "**** %2d: 0x%08x\n", f, bfa);
3127             do {
3128               ufoDumpWordHeader(UFO_BFA_TO_LFA(bfa));
3129               bfa = ufoImgGetU32(bfa);
3130             } while (bfa != 0);
3131           }
3132           htbl += 4u;
3133         }
3134       }
3135     }
3136   }
3137 }
3138 */
3139
3140
3141 // if set, this will be used when we are out of include files. intended for UrAsm.
3142 // return 0 if there is no more lines, otherwise the string should be copied
3143 // to buffer, `*fname` and `*fline` should be properly set.
3144 int (*ufoFileReadLine) (void *buf, size_t bufsize, const char **fname, int *fline) = NULL;
3145
3146
3147 //==========================================================================
3148 //
3149 //  ufoLoadNextUserLine
3150 //
3151 //==========================================================================
3152 static int ufoLoadNextUserLine (void) {
3153   uint32_t tibPos = 0;
3154   const char *fname = NULL;
3155   int fline = 0;
3156   ufoResetTib();
3157   if (ufoFileReadLine != NULL && ufoFileReadLine(ufoCurrFileLine, 510, &fname, &fline) != 0) {
3158     ufoCurrFileLine[510] = 0;
3159     uint32_t slen = (uint32_t)strlen(ufoCurrFileLine);
3160     while (slen != 0 && (ufoCurrFileLine[slen - 1u] == 10 || ufoCurrFileLine[slen - 1u] == 13)) {
3161       slen -= 1u;
3162     }
3163     if (tibPos + slen + 1u > UFO_ADDR_HANDLE_OFS_MASK) {
3164       ufoFatal("input text line too long (at least %u bytes)", tibPos + slen);
3165     }
3166     ufoTibEnsureSize(tibPos + slen + 1u);
3167     for (uint32_t f = 0; f < slen; f += 1) {
3168       ufoTibPokeChOfs(((const unsigned char *)ufoCurrFileLine)[f], tibPos + f);
3169     }
3170     ufoTibPokeChOfs(0, tibPos + slen);
3171     tibPos += slen;
3172     if (fname == NULL) fname = "<user>";
3173     ufoSetInFileName(fname);
3174     ufoInFileLine = fline;
3175     return 1;
3176   } else {
3177     return 0;
3178   }
3179 }
3180
3181
3182 //==========================================================================
3183 //
3184 //  ufoLoadNextLine_NativeMode
3185 //
3186 //  load next file line into TIB
3187 //  always strips final '\n'
3188 //
3189 //  return 0 on EOF, 1 on success
3190 //
3191 //==========================================================================
3192 static int ufoLoadNextLine (int crossInclude) {
3193   int done = 0;
3194   uint32_t tibPos = 0;
3195   ufoResetTib();
3196
3197   if (ufoMode == UFO_MODE_MACRO) {
3198     //fprintf(stderr, "***MAC!\n");
3199     return 0;
3200   }
3201
3202   while (ufoInFile != NULL && !done) {
3203     ufoCurrIncludeLineFileOfs = ftell(ufoInFile);
3204     if (fgets(ufoCurrFileLine, 510, ufoInFile) != NULL) {
3205       // check for a newline
3206       // if there is no newline char at the end, the string was truncated
3207       ufoCurrFileLine[510] = 0;
3208       const uint32_t slen = (uint32_t)strlen(ufoCurrFileLine);
3209       if (tibPos + slen + 1u > UFO_ADDR_HANDLE_OFS_MASK) {
3210         ufoFatal("input text line too long (at least %u bytes)", tibPos + slen);
3211       }
3212       ufoTibEnsureSize(tibPos + slen + 1u);
3213       for (uint32_t f = 0; f < slen; f += 1) {
3214         ufoTibPokeChOfs(((const unsigned char *)ufoCurrFileLine)[f], tibPos + f);
3215       }
3216       ufoTibPokeChOfs(0, tibPos + slen);
3217       tibPos += slen;
3218       if (slen != 0 && (ufoCurrFileLine[slen - 1u] == 13 || ufoCurrFileLine[slen - 1u] == 10)) {
3219         ++ufoInFileLine;
3220         done = 1;
3221       } else {
3222         // continuation, nothing to do
3223       }
3224     } else {
3225       // if we read nothing, this is EOF
3226       if (tibPos == 0 && crossInclude) {
3227         // we read nothing, and allowed to cross include boundaries
3228         ufoPopInFile();
3229       } else {
3230         done = 1;
3231       }
3232     }
3233   }
3234
3235   if (tibPos == 0) {
3236     // eof, try user-supplied input
3237     if (ufoFileStackPos == 0) {
3238       return ufoLoadNextUserLine();
3239     } else {
3240       return 0;
3241     }
3242   } else {
3243     // if we read at least something, this is not EOF
3244     return 1;
3245   }
3246 }
3247
3248
3249 // ////////////////////////////////////////////////////////////////////////// //
3250 // debug
3251
3252 // DUMP-STACK
3253 // ( -- )
3254 UFWORD(DUMP_STACK) {
3255   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3256   printf("***UFO STACK DEPTH: %u\n", ufoSP);
3257   uint32_t xsp = ufoSP;
3258   if (xsp > 16) xsp = 16;
3259   for (uint32_t sp = 0; sp < xsp; ++sp) {
3260     printf("  %2u: 0x%08x  %d%s\n",
3261            sp, ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1],
3262            (sp == 0 ? " -- TOS" : ""));
3263   }
3264   if (ufoSP > 16) printf("    ...more...\n");
3265   ufoLastEmitWasCR = 1;
3266 }
3267
3268 // BACKTRACE
3269 // ( -- )
3270 UFWORD(UFO_BACKTRACE) {
3271   ufoFlushOutput();
3272   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3273   if (ufoInFile != NULL) {
3274     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
3275   } else {
3276     fprintf(stderr, "*** somewhere in time ***\n");
3277   }
3278   ufoBacktrace(ufoIP, 1);
3279 }
3280
3281 #ifdef UFO_MTASK_ALLOWED
3282 // DUMP-STACK-TASK
3283 // ( stid -- )
3284 UFWORD(DUMP_STACK_TASK) {
3285   UfoState *st = ufoFindState(ufoPop());
3286   if (st == NULL) ufoFatal("invalid state id");
3287   // temporarily switch the task
3288   UfoState *oldst = ufoCurrState; ufoCurrState = st;
3289   // dump
3290   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3291   printf("***UFO STACK DEPTH: %u\n", ufoSP);
3292   uint32_t xsp = ufoSP;
3293   if (xsp > 16) xsp = 16;
3294   for (uint32_t sp = 0; sp < xsp; ++sp) {
3295     printf("  %2u: 0x%08x  %d%s\n",
3296            sp, ufoDStack[xsp - sp - 1], (int32_t)ufoDStack[xsp - sp - 1],
3297            (sp == 0 ? " -- TOS" : ""));
3298   }
3299   if (ufoSP > 16) printf("    ...more...\n");
3300   ufoLastEmitWasCR = 1;
3301   // restore state
3302   ufoCurrState = oldst;
3303 }
3304
3305 // DUMP-RSTACK-TASK
3306 // ( stid -- )
3307 UFWORD(DUMP_RSTACK_TASK) {
3308   UfoState *st = ufoFindState(ufoPop());
3309   if (st == NULL) ufoFatal("invalid state id");
3310   // temporarily switch the task
3311   UfoState *oldst = ufoCurrState; ufoCurrState = st;
3312   // dump
3313   ufoFlushOutput();
3314   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3315   if (ufoInFile != NULL) {
3316     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
3317   } else {
3318     fprintf(stderr, "*** somewhere in time ***\n");
3319   }
3320   ufoBacktrace(ufoIP, 0);
3321   // restore state
3322   ufoCurrState = oldst;
3323 }
3324
3325 // BACKTRACE-TASK
3326 // ( stid -- )
3327 UFWORD(UFO_BACKTRACE_TASK) {
3328   UfoState *st = ufoFindState(ufoPop());
3329   if (st == NULL) ufoFatal("invalid state id");
3330   // temporarily switch the task
3331   UfoState *oldst = ufoCurrState; ufoCurrState = st;
3332   // dump
3333   ufoFlushOutput();
3334   if (!ufoLastEmitWasCR) { printf("\n"); ufoLastEmitWasCR = 1; }
3335   if (ufoInFile != NULL) {
3336     fprintf(stderr, "*** at file %s, line %d ***\n", ufoInFileName, ufoInFileLine);
3337   } else {
3338     fprintf(stderr, "*** somewhere in time ***\n");
3339   }
3340   ufoBacktrace(ufoIP, 1);
3341   // restore state
3342   ufoCurrState = oldst;
3343 }
3344 #endif
3345
3346
3347 // ////////////////////////////////////////////////////////////////////////// //
3348 // some init words, and PAD
3349 //
3350
3351 // NOOP
3352 // ( -- )
3353 UFWORD(NOOP) {}
3354
3355 // (NOTIMPL)
3356 // ( -- )
3357 UFWORD(PAR_NOTIMPL) {
3358   ufoFatal("not implemented");
3359 }
3360
3361 // SP0!
3362 // ( -- )
3363 UFWORD(SP0_STORE) { ufoSP = 0; }
3364
3365 // RP0!
3366 // ( -- )
3367 UFWORD(RP0_STORE) {
3368   ufoRP = 0;
3369 }
3370
3371 // PAD
3372 // ( -- pad )
3373 // PAD is at the beginning of temp area
3374 UFWORD(PAD) {
3375   ufoPush(UFO_PAD_ADDR);
3376 }
3377
3378 // HERE
3379 // ( -- here )
3380 UFWORD(HERE) {
3381   ufoPush(UFO_GET_DP());
3382 }
3383
3384 // ALIGN-HERE
3385 // ( -- )
3386 UFWORD(ALIGN_HERE) {
3387   ufoImgEmitAlign();
3388 }
3389
3390
3391 // ////////////////////////////////////////////////////////////////////////// //
3392 // peeks and pokes with address register
3393 //
3394
3395 // A>
3396 // ( -- regA )
3397 UFWORD(REGA_LOAD) {
3398   ufoPush(ufoRegA);
3399 }
3400
3401 // >A
3402 // ( regA -- )
3403 UFWORD(REGA_STORE) {
3404   ufoRegA = ufoPop();
3405 }
3406
3407 // A-SWAP
3408 // ( regA -- oldA )
3409 // swap TOS and A
3410 UFWORD(REGA_SWAP) {
3411   const uint32_t newa = ufoPop();
3412   ufoPush(ufoRegA);
3413   ufoRegA = newa;
3414 }
3415
3416 // +1>A
3417 // ( -- )
3418 UFWORD(REGA_INC) {
3419   ufoRegA += 1u;
3420 }
3421
3422 // +2>A
3423 // ( -- )
3424 UFWORD(REGA_INC_WORD) {
3425   ufoRegA += 2u;
3426 }
3427
3428 // +4>A
3429 // ( -- )
3430 UFWORD(REGA_INC_CELL) {
3431   ufoRegA += 4u;
3432 }
3433
3434 // -1>A
3435 // ( -- )
3436 UFWORD(REGA_DEC) {
3437   ufoRegA -= 1u;
3438 }
3439
3440 // -2>A
3441 // ( -- )
3442 UFWORD(REGA_DEC_WORD) {
3443   ufoRegA -= 2u;
3444 }
3445
3446 // -4>A
3447 // ( -- )
3448 UFWORD(REGA_DEC_CELL) {
3449   ufoRegA -= 4u;
3450 }
3451
3452 // A>R
3453 // ( -- | rega )
3454 UFWORD(REGA_TO_R) {
3455   ufoRPush(ufoRegA);
3456 }
3457
3458 // R>A
3459 // ( | rega -- )
3460 UFWORD(R_TO_REGA) {
3461   ufoRegA = ufoRPop();
3462 }
3463
3464
3465 // ////////////////////////////////////////////////////////////////////////// //
3466 // useful to work with handles and normal addreses uniformly
3467 //
3468
3469 // C@A
3470 // ( -- byte )
3471 UFWORD(CPEEK_REGA) {
3472   ufoPush(ufoImgGetU8(ufoRegA));
3473 }
3474
3475 // W@A
3476 // ( -- word )
3477 UFWORD(WPEEK_REGA) {
3478   ufoPush(ufoImgGetU16(ufoRegA));
3479 }
3480
3481 // @A
3482 // ( -- value )
3483 UFWORD(PEEK_REGA) {
3484   ufoPush(ufoImgGetU32(ufoRegA));
3485 }
3486
3487 // C!A
3488 // ( byte -- )
3489 UFWORD(CPOKE_REGA) {
3490   ufoImgPutU8(ufoRegA, ufoPop());
3491 }
3492
3493 // W!A
3494 // ( word -- )
3495 UFWORD(WPOKE_REGA) {
3496   ufoImgPutU16(ufoRegA, ufoPop());
3497 }
3498
3499 // !A
3500 // ( value -- )
3501 UFWORD(POKE_REGA) {
3502   ufoImgPutU32(ufoRegA, ufoPop());
3503 }
3504
3505 // C@A+
3506 // ( idx -- byte )
3507 UFWORD(CPEEK_REGA_IDX) {
3508   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3509     const uint32_t idx = ufoPop();
3510     const uint32_t newaddr = ufoRegA + idx;
3511     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK)) {
3512       ufoPush(ufoImgGetU8(newaddr));
3513     } else {
3514       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3515                ufoRegA, idx, newaddr);
3516     }
3517   } else {
3518     ufoPush(ufoRegA);
3519     UFCALL(PAR_HANDLE_LOAD_BYTE);
3520   }
3521 }
3522
3523 // W@A+
3524 // ( idx -- word )
3525 UFWORD(WPEEK_REGA_IDX) {
3526   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3527     const uint32_t idx = ufoPop();
3528     const uint32_t newaddr = ufoRegA + idx;
3529     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3530         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 1u) & UFO_ADDR_SPECIAL_BITS_MASK))
3531     {
3532       ufoPush(ufoImgGetU16(newaddr));
3533     } else {
3534       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3535                ufoRegA, idx, newaddr);
3536     }
3537   } else {
3538     ufoPush(ufoRegA);
3539     UFCALL(PAR_HANDLE_LOAD_WORD);
3540   }
3541 }
3542
3543 // @A+
3544 // ( idx -- value )
3545 UFWORD(PEEK_REGA_IDX) {
3546   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3547     const uint32_t idx = ufoPop();
3548     const uint32_t newaddr = ufoRegA + idx;
3549     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3550         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 3u) & UFO_ADDR_SPECIAL_BITS_MASK))
3551     {
3552       ufoPush(ufoImgGetU32(newaddr));
3553     } else {
3554       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3555                ufoRegA, idx, newaddr);
3556     }
3557   } else {
3558     ufoPush(ufoRegA);
3559     UFCALL(PAR_HANDLE_LOAD_CELL);
3560   }
3561 }
3562
3563 // C!A+
3564 // ( byte idx -- )
3565 UFWORD(CPOKE_REGA_IDX) {
3566   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3567     const uint32_t idx = ufoPop();
3568     const uint32_t newaddr = ufoRegA + idx;
3569     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK)) {
3570       const uint32_t value = ufoPop();
3571       ufoImgPutU8(newaddr, value);
3572     } else {
3573       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3574                ufoRegA, idx, newaddr);
3575     }
3576   } else {
3577     ufoPush(ufoRegA);
3578     UFCALL(PAR_HANDLE_STORE_BYTE);
3579   }
3580 }
3581
3582 // W!A+
3583 // ( word idx -- )
3584 UFWORD(WPOKE_REGA_IDX) {
3585   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3586     const uint32_t idx = ufoPop();
3587     const uint32_t newaddr = ufoRegA + idx;
3588     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3589         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 1u) & UFO_ADDR_SPECIAL_BITS_MASK))
3590     {
3591       const uint32_t value = ufoPop();
3592       ufoImgPutU16(newaddr, value);
3593     } else {
3594       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3595                ufoRegA, idx, newaddr);
3596     }
3597   } else {
3598     ufoPush(ufoRegA);
3599     UFCALL(PAR_HANDLE_STORE_WORD);
3600   }
3601 }
3602
3603 // !A+
3604 // ( value idx -- )
3605 UFWORD(POKE_REGA_IDX) {
3606   if ((ufoRegA & UFO_ADDR_HANDLE_BIT) == 0) {
3607     const uint32_t idx = ufoPop();
3608     const uint32_t newaddr = ufoRegA + idx;
3609     if ((ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == (newaddr & UFO_ADDR_SPECIAL_BITS_MASK) &&
3610         (ufoRegA & UFO_ADDR_SPECIAL_BITS_MASK) == ((newaddr + 3u) & UFO_ADDR_SPECIAL_BITS_MASK))
3611     {
3612       const uint32_t value = ufoPop();
3613       ufoImgPutU32(newaddr, value);
3614     } else {
3615       ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3616                ufoRegA, idx, newaddr);
3617     }
3618   } else {
3619     ufoPush(ufoRegA);
3620     UFCALL(PAR_HANDLE_STORE_CELL);
3621   }
3622 }
3623
3624 // C!+1>A
3625 // ( byte -- )
3626 UFWORD(CPOKE_REGA_INC1) {
3627   ufoImgPutU8(ufoRegA, ufoPop());
3628   ufoRegA += 1u;
3629 }
3630
3631 // W!+2>A
3632 // ( byte -- )
3633 UFWORD(WPOKE_REGA_INC2) {
3634   ufoImgPutU16(ufoRegA, ufoPop());
3635   ufoRegA += 2u;
3636 }
3637
3638 // !+4>A
3639 // ( val32 -- )
3640 UFWORD(POKE_REGA_INC4) {
3641   ufoImgPutU32(ufoRegA, ufoPop());
3642   ufoRegA += 4u;
3643 }
3644
3645 // C@+1>A
3646 // ( -- byte )
3647 UFWORD(CPEEK_REGA_INC1) {
3648   ufoPush(ufoImgGetU8(ufoRegA));
3649   ufoRegA += 1u;
3650 }
3651
3652 // W@+2>A
3653 // ( -- byte )
3654 UFWORD(WPEEK_REGA_INC2) {
3655   ufoPush(ufoImgGetU16(ufoRegA));
3656   ufoRegA += 2u;
3657 }
3658
3659 // @+4>A
3660 // ( -- val32 )
3661 UFWORD(PEEK_REGA_INC4) {
3662   ufoPush(ufoImgGetU32(ufoRegA));
3663   ufoRegA += 4u;
3664 }
3665
3666
3667 // ////////////////////////////////////////////////////////////////////////// //
3668 // peeks and pokes
3669 //
3670
3671 // COMPILER:CFA,
3672 // ( cfa -- )
3673 UFWORD(CFA_COMMA) {
3674   const uint32_t cfa = ufoPop();
3675   ufoImgEmitCFA(cfa);
3676 }
3677
3678 // (BRANCH-ADDR!)
3679 // ( destaddr addr -- )
3680 // write "branch to destaddr" address to addr
3681 UFWORD(PAR_BRANCH_ADDR_POKE) {
3682   const uint32_t addr = ufoPop();
3683   const uint32_t dest = ufoPop();
3684   #ifdef UFO_RELATIVE_BRANCH
3685   ufoImgPutU32(addr, dest - addr);
3686   #else
3687   ufoImgPutU32(addr, dest);
3688   #endif
3689 }
3690
3691 // (BRANCH-ADDR@)
3692 // ( addr -- dest )
3693 // read branch address
3694 UFWORD(PAR_BRANCH_ADDR_PEEK) {
3695   UFO_STACK(1);
3696   #ifdef UFO_RELATIVE_BRANCH
3697   UFO_TOS += ufoImgGetU32(UFO_TOS);
3698   #else
3699   UFO_TOS = ufoImgGetU32(UFO_TOS);
3700   #endif
3701 }
3702
3703 // C@
3704 // ( addr -- value8 )
3705 UFWORD(CPEEK) {
3706   const uint32_t addr = ufoPop();
3707   ufoPush(ufoImgGetU8(addr));
3708 }
3709
3710 // W@
3711 // ( addr -- value16 )
3712 UFWORD(WPEEK) {
3713   const uint32_t addr = ufoPop();
3714   ufoPush(ufoImgGetU16(addr));
3715 }
3716
3717 // @
3718 // ( addr -- value32 )
3719 UFWORD(PEEK) {
3720   const uint32_t addr = ufoPop();
3721   ufoPush(ufoImgGetU32(addr));
3722 }
3723
3724 // C!
3725 // ( val8 addr -- )
3726 UFWORD(CPOKE) {
3727   const uint32_t addr = ufoPop();
3728   const uint32_t val = ufoPop();
3729   ufoImgPutU8(addr, val);
3730 }
3731
3732 // W!
3733 // ( val16 addr -- )
3734 UFWORD(WPOKE) {
3735   const uint32_t addr = ufoPop();
3736   const uint32_t val = ufoPop();
3737   ufoImgPutU16(addr, val);
3738 }
3739
3740 // !
3741 // ( val32 addr -- )
3742 UFWORD(POKE) {
3743   const uint32_t addr = ufoPop();
3744   const uint32_t val = ufoPop();
3745   ufoImgPutU32(addr, val);
3746 }
3747
3748 // (DIRECT:@)
3749 // ( -- value32 )
3750 // code arg is address
3751 UFWORD(DIRECT_PEEK) {
3752   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3753   ufoPush(ufoImgGetU32(addr));
3754 }
3755
3756 // (DIRECT:0:!)
3757 // ( -- )
3758 // code arg is address
3759 UFWORD(DIRECT_POKE0) {
3760   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3761   ufoImgPutU32(addr, 0);
3762 }
3763
3764 // (DIRECT:1:!)
3765 // ( -- )
3766 // code arg is address
3767 UFWORD(DIRECT_POKE1) {
3768   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3769   ufoImgPutU32(addr, 1);
3770 }
3771
3772 // (DIRECT:-1:!)
3773 // ( -- )
3774 // code arg is address
3775 UFWORD(DIRECT_POKEM1) {
3776   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3777   ufoImgPutU32(addr, ~(uint32_t)0);
3778 }
3779
3780 // (DIRECT:!)
3781 // ( value32 -- )
3782 // code arg is address
3783 UFWORD(DIRECT_POKE) {
3784   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3785   const uint32_t val = ufoPop();
3786   ufoImgPutU32(addr, val);
3787 }
3788
3789 // (DIRECT:+!)
3790 // ( value32 -- )
3791 // code arg is address
3792 UFWORD(DIRECT_ADD_POKE) {
3793   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3794   uint32_t val = ufoPop();
3795   val += ufoImgGetU32(addr);
3796   ufoImgPutU32(addr, val);
3797 }
3798
3799 // (DIRECT:-!)
3800 // ( value32 -- )
3801 // code arg is address
3802 UFWORD(DIRECT_SUB_POKE) {
3803   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3804   uint32_t val = ufoPop();
3805   val -= ufoImgGetU32(addr);
3806   ufoImgPutU32(addr, val);
3807 }
3808
3809 // (DIRECT:+:@)
3810 // ( addr -- value32 )
3811 // code arg is offset
3812 UFWORD(DIRECT_OFS_PEEK) {
3813   uint32_t addr = ufoPop();
3814   addr += ufoImgGetU32(ufoIP); ufoIP += 4u;
3815   ufoPush(ufoImgGetU32(addr));
3816 }
3817
3818 // (DIRECT:+:!)
3819 // ( value32 addr -- )
3820 // code arg is offset
3821 UFWORD(DIRECT_OFS_POKE) {
3822   uint32_t addr = ufoPop();
3823   uint32_t val = ufoPop();
3824   addr += ufoImgGetU32(ufoIP); ufoIP += 4u;
3825   ufoImgPutU32(addr, val);
3826 }
3827
3828 // (DIRECT:1+!)
3829 // ( -- )
3830 // code arg is address
3831 UFWORD(DIRECT_POKE_INC1) {
3832   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3833   const uint32_t val = ufoImgGetU32(addr);
3834   ufoImgPutU32(addr, val + 1u);
3835 }
3836
3837 // (DIRECT:2+!)
3838 // ( -- )
3839 // code arg is address
3840 UFWORD(DIRECT_POKE_INC2) {
3841   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3842   const uint32_t val = ufoImgGetU32(addr);
3843   ufoImgPutU32(addr, val + 2u);
3844 }
3845
3846 // (DIRECT:4+!)
3847 // ( -- )
3848 // code arg is address
3849 UFWORD(DIRECT_POKE_INC4) {
3850   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3851   const uint32_t val = ufoImgGetU32(addr);
3852   ufoImgPutU32(addr, val + 4u);
3853 }
3854
3855 // (DIRECT:8+!)
3856 // ( -- )
3857 // code arg is address
3858 UFWORD(DIRECT_POKE_INC8) {
3859   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3860   const uint32_t val = ufoImgGetU32(addr);
3861   ufoImgPutU32(addr, val + 8u);
3862 }
3863
3864 // (DIRECT:1-!)
3865 // ( -- )
3866 // code arg is address
3867 UFWORD(DIRECT_POKE_DEC1) {
3868   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3869   const uint32_t val = ufoImgGetU32(addr);
3870   ufoImgPutU32(addr, val - 1u);
3871 }
3872
3873 // (DIRECT:2-!)
3874 // ( -- )
3875 // code arg is address
3876 UFWORD(DIRECT_POKE_DEC2) {
3877   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3878   const uint32_t val = ufoImgGetU32(addr);
3879   ufoImgPutU32(addr, val - 2u);
3880 }
3881
3882 // (DIRECT:4-!)
3883 // ( -- )
3884 // code arg is address
3885 UFWORD(DIRECT_POKE_DEC4) {
3886   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3887   const uint32_t val = ufoImgGetU32(addr);
3888   ufoImgPutU32(addr, val - 4u);
3889 }
3890
3891 // (DIRECT:8-!)
3892 // ( -- )
3893 // code arg is address
3894 UFWORD(DIRECT_POKE_DEC8) {
3895   const uint32_t addr = ufoImgGetU32(ufoIP); ufoIP += 4u;
3896   const uint32_t val = ufoImgGetU32(addr);
3897   ufoImgPutU32(addr, val - 8u);
3898 }
3899
3900 // SWAP-C!
3901 // ( addr value -- )
3902 UFWORD(SWAP_CPOKE) {
3903   const uint32_t val = ufoPop();
3904   const uint32_t addr = ufoPop();
3905   ufoImgPutU8(addr, val);
3906 }
3907
3908 // SWAP-W!
3909 // ( addr value -- )
3910 UFWORD(SWAP_WPOKE) {
3911   const uint32_t val = ufoPop();
3912   const uint32_t addr = ufoPop();
3913   ufoImgPutU16(addr, val);
3914 }
3915
3916 // SWAP!
3917 // ( addr value -- )
3918 UFWORD(SWAP_POKE) {
3919   const uint32_t val = ufoPop();
3920   const uint32_t addr = ufoPop();
3921   ufoImgPutU32(addr, val);
3922 }
3923
3924 // OR-C!
3925 // ( value addr -- )
3926 UFWORD(OR_CPOKE) {
3927   const uint32_t addr = ufoPop();
3928   uint32_t val = ufoPop();
3929   val |= ufoImgGetU8(addr);
3930   ufoImgPutU8(addr, val);
3931 }
3932
3933 // OR-W!
3934 // ( value addr -- )
3935 UFWORD(OR_WPOKE) {
3936   const uint32_t addr = ufoPop();
3937   uint32_t val = ufoPop();
3938   val |= ufoImgGetU16(addr);
3939   ufoImgPutU16(addr, val);
3940 }
3941
3942 // OR!
3943 // ( value addr -- )
3944 UFWORD(OR_POKE) {
3945   const uint32_t addr = ufoPop();
3946   uint32_t val = ufoPop();
3947   val |= ufoImgGetU32(addr);
3948   ufoImgPutU32(addr, val);
3949 }
3950
3951 // XOR-C!
3952 // ( value addr -- )
3953 UFWORD(XOR_CPOKE) {
3954   const uint32_t addr = ufoPop();
3955   uint32_t val = ufoPop();
3956   val ^= ufoImgGetU8(addr);
3957   ufoImgPutU8(addr, val);
3958 }
3959
3960 // XOR-W!
3961 // ( value addr -- )
3962 UFWORD(XOR_WPOKE) {
3963   const uint32_t addr = ufoPop();
3964   uint32_t val = ufoPop();
3965   val ^= ufoImgGetU16(addr);
3966   ufoImgPutU16(addr, val);
3967 }
3968
3969 // XOR!
3970 // ( value addr -- )
3971 UFWORD(XOR_POKE) {
3972   const uint32_t addr = ufoPop();
3973   uint32_t val = ufoPop();
3974   val ^= ufoImgGetU32(addr);
3975   ufoImgPutU32(addr, val);
3976 }
3977
3978 // ~AND-C!
3979 // ( value addr -- )
3980 UFWORD(NAND_CPOKE) {
3981   const uint32_t addr = ufoPop();
3982   uint32_t val = ufoPop();
3983   val = ufoImgGetU8(addr)&~val;
3984   ufoImgPutU8(addr, val);
3985 }
3986
3987 // ~AND-W!
3988 // ( value addr -- )
3989 UFWORD(NAND_WPOKE) {
3990   const uint32_t addr = ufoPop();
3991   uint32_t val = ufoPop();
3992   val = ufoImgGetU16(addr)&~val;
3993   ufoImgPutU16(addr, val);
3994 }
3995
3996 // ~AND!
3997 // ( value addr -- )
3998 UFWORD(NAND_POKE) {
3999   const uint32_t addr = ufoPop();
4000   uint32_t val = ufoPop();
4001   val = ufoImgGetU32(addr)&~val;
4002   ufoImgPutU32(addr, val);
4003 }
4004
4005 // COUNT
4006 // ( addr -- addr+4 addr@ )
4007 UFWORD(COUNT) {
4008   const uint32_t addr = ufoPop();
4009   const uint32_t count = ufoImgGetU32(addr);
4010   ufoPush(addr + 4u);
4011   ufoPush(count);
4012 }
4013
4014 // ID-COUNT
4015 // ( addr -- addr+4 addr@&0xff )
4016 UFWORD(ID_COUNT) {
4017   const uint32_t addr = ufoPop();
4018   const uint32_t count = ufoImgGetU32(addr);
4019   ufoPush(addr + 4u);
4020   ufoPush(count & 0xffU);
4021 }
4022
4023
4024 // BCOUNT
4025 // ( addr -- addr+1 addrC@ )
4026 UFWORD(BCOUNT) {
4027   const uint32_t addr = ufoPop();
4028   const uint32_t count = ufoImgGetU8(addr);
4029   ufoPush(addr + 1u);
4030   ufoPush(count & 0xffU);
4031 }
4032
4033 // 0!
4034 // ( addr -- )
4035 UFWORD(POKE_0) {
4036   ufoImgPutU32(ufoPop(), 0);
4037 }
4038
4039 // 1!
4040 // ( addr -- )
4041 UFWORD(POKE_1) {
4042   ufoImgPutU32(ufoPop(), 1);
4043 }
4044
4045 // 1+!
4046 // ( addr -- )
4047 UFWORD(POKE_INC_1) {
4048   const uint32_t addr = ufoPop();
4049   const uint32_t val = ufoImgGetU32(addr);
4050   ufoImgPutU32(addr, val + 1u);
4051 }
4052
4053 // 1-!
4054 // ( addr -- )
4055 UFWORD(POKE_DEC_1) {
4056   const uint32_t addr = ufoPop();
4057   const uint32_t val = ufoImgGetU32(addr);
4058   ufoImgPutU32(addr, val - 1u);
4059 }
4060
4061 // +!
4062 // ( delta addr -- )
4063 UFWORD(POKE_INC) {
4064   const uint32_t addr = ufoPop();
4065   const uint32_t delta = ufoPop();
4066   const uint32_t val = ufoImgGetU32(addr);
4067   ufoImgPutU32(addr, val + delta);
4068 }
4069
4070 // -!
4071 // ( delta addr -- )
4072 UFWORD(POKE_DEC) {
4073   const uint32_t addr = ufoPop();
4074   const uint32_t delta = ufoPop();
4075   const uint32_t val = ufoImgGetU32(addr);
4076   ufoImgPutU32(addr, val - delta);
4077 }
4078
4079
4080 // ////////////////////////////////////////////////////////////////////////// //
4081 // dictionary emitters
4082 //
4083
4084 // C,
4085 // ( val8 -- )
4086 UFWORD(CCOMMA) { const uint32_t val = ufoPop(); ufoImgEmitU8(val); }
4087
4088 // W,
4089 // ( val16 -- )
4090 UFWORD(WCOMMA) { const uint32_t val = ufoPop(); ufoImgEmitU16(val); }
4091
4092 // ,
4093 // ( val -- )
4094 UFWORD(COMMA) { const uint32_t val = ufoPop(); ufoImgEmitU32(val); }
4095
4096
4097 // ////////////////////////////////////////////////////////////////////////// //
4098 // literal pushers
4099 //
4100
4101 // (LIT) ( -- n )
4102 UFWORD(PAR_LIT) {
4103   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
4104   ufoPush(v);
4105 }
4106
4107 // (LITCFA) ( -- n )
4108 UFWORD(PAR_LITCFA) {
4109   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
4110   ufoPush(v);
4111 }
4112
4113 // (LITPFA) ( -- n )
4114 UFWORD(PAR_LITPFA) {
4115   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
4116   ufoPush(v);
4117 }
4118
4119 // (LITVOCID) ( -- n )
4120 UFWORD(PAR_LITVOCID) {
4121   const uint32_t v = ufoImgGetU32(ufoIP); ufoIP += 4;
4122   ufoPush(v);
4123 }
4124
4125 // (LITSTR8)
4126 UFWORD(PAR_LITSTR8) {
4127   const uint32_t count = ufoImgGetU8(ufoIP); ufoIP += 1;
4128   ufoPush(ufoIP);
4129   ufoPush(count);
4130   ufoIP += count + 1; // 1 for terminating 0
4131   ufoIP = UFO_ALIGN4(ufoIP);
4132 }
4133
4134
4135 // ////////////////////////////////////////////////////////////////////////// //
4136 // jumps, etc.
4137 //
4138
4139 #ifdef UFO_RELATIVE_BRANCH
4140 # define UFO_IP_BRANCH()  (ufoIP += ufoImgGetU32(ufoIP))
4141 #else
4142 # define UFO_IP_BRANCH()  (ufoIP = ufoImgGetU32(ufoIP))
4143 #endif
4144
4145 // (BRANCH) ( -- )
4146 UFWORD(PAR_BRANCH) {
4147   UFO_IP_BRANCH();
4148 }
4149
4150 // (TBRANCH) ( flag )
4151 UFWORD(PAR_TBRANCH) {
4152   if (ufoPop()) {
4153     UFO_IP_BRANCH();
4154   } else {
4155     ufoIP += 4u;
4156   }
4157 }
4158
4159 // (0BRANCH) ( flag )
4160 UFWORD(PAR_0BRANCH) {
4161   if (!ufoPop()) {
4162     UFO_IP_BRANCH();
4163   } else {
4164     ufoIP += 4u;
4165   }
4166 }
4167
4168 // (+0BRANCH) ( flag )
4169 UFWORD(PAR_P0BRANCH) {
4170   if ((ufoPop() & 0x80000000u) == 0) {
4171     UFO_IP_BRANCH();
4172   } else {
4173     ufoIP += 4u;
4174   }
4175 }
4176
4177 // (+BRANCH) ( flag )
4178 UFWORD(PAR_PBRANCH) {
4179   const int32_t v = (int32_t)ufoPop();
4180   if (v > 0) {
4181     UFO_IP_BRANCH();
4182   } else {
4183     ufoIP += 4u;
4184   }
4185 }
4186
4187 // (-0BRANCH) ( flag )
4188 UFWORD(PAR_M0BRANCH) {
4189   const int32_t v = (int32_t)ufoPop();
4190   if (v <= 0) {
4191     UFO_IP_BRANCH();
4192   } else {
4193     ufoIP += 4u;
4194   }
4195 }
4196
4197 // (-BRANCH) ( flag )
4198 UFWORD(PAR_MBRANCH) {
4199   if ((ufoPop() & 0x80000000u) != 0) {
4200     UFO_IP_BRANCH();
4201   } else {
4202     ufoIP += 4u;
4203   }
4204 }
4205
4206 // (DATASKIP) ( -- )
4207 UFWORD(PAR_DATASKIP) {
4208   ufoIP += UFO_ALIGN4(4u + ufoImgGetU32(ufoIP));
4209 }
4210
4211 // (OR-BRANCH)
4212 // ( !0 -- !0 ) -- jmp
4213 // ( 0 -- ) -- no jmp
4214 UFWORD(PAR_OR_BRANCH) {
4215   UFO_STACK(1);
4216   if (UFO_TOS != 0) {
4217     UFO_IP_BRANCH();
4218   } else {
4219     ufoSP -= 1u;
4220     ufoIP += 4u;
4221   }
4222 }
4223
4224 // (AND-BRANCH)
4225 // ( 0 -- 0 ) -- jmp
4226 // ( !0 -- ) -- no jmp
4227 UFWORD(PAR_AND_BRANCH) {
4228   UFO_STACK(1);
4229   if (UFO_TOS == 0) {
4230     UFO_IP_BRANCH();
4231   } else {
4232     ufoSP -= 1u;
4233     ufoIP += 4u;
4234   }
4235 }
4236
4237 // (?DUP-0BRANCH)
4238 // ( 0 -- ) -- jmp
4239 // ( !0 -- !0 ) -- no jmp
4240 UFWORD(PAR_QDUP_0BRANCH) {
4241   UFO_STACK(1);
4242   if (UFO_TOS != 0) {
4243     ufoIP += 4u;
4244   } else {
4245     ufoSP -= 1u;
4246     UFO_IP_BRANCH();
4247   }
4248 }
4249
4250 // (CASE-BRANCH)
4251 // ( 0 -- ) -- jmp
4252 // ( n !0 -- ) -- no jmp
4253 UFWORD(PAR_CASE_BRANCH) {
4254   UFO_STACK(2);
4255   if (UFO_TOS == 0) {
4256     ufoSP -= 1u;
4257     UFO_IP_BRANCH();
4258   } else {
4259     ufoSP -= 2u;
4260     ufoIP += 4u;
4261   }
4262 }
4263
4264
4265 // ////////////////////////////////////////////////////////////////////////// //
4266 // execute words by CFA
4267 //
4268
4269 // EXECUTE ( cfa )
4270 UFWORD(EXECUTE) {
4271   UFO_EXEC_CFA(ufoPop());
4272 }
4273
4274 // EXECUTE-TAIL ( cfa )
4275 UFWORD(EXECUTE_TAIL) {
4276   if (ufoRP != 0) ufoIP = ufoRPop();
4277   UFO_EXEC_CFA(ufoPop());
4278 }
4279
4280 // @EXECUTE ( addr )
4281 UFWORD(LOAD_EXECUTE) {
4282   const uint32_t addr = ufoPop();
4283   UFO_EXEC_CFA(ufoImgGetU32(addr));
4284 }
4285
4286 // @EXECUTE-TAIL ( cfa )
4287 UFWORD(LOAD_EXECUTE_TAIL) {
4288   if (ufoRP != 0) ufoIP = ufoRPop();
4289   const uint32_t addr = ufoPop();
4290   UFO_EXEC_CFA(ufoImgGetU32(addr));
4291 }
4292
4293 // (FORTH-CALL) ( pfa )
4294 UFWORD(FORTH_CALL) {
4295   ufoRPush(ufoIP);
4296   ufoIP = ufoPop();
4297 }
4298
4299 // (FORTH-TAIL-CALL) ( pfa )
4300 UFWORD(FORTH_TAIL_CALL) {
4301   ufoIP = ufoPop();
4302 }
4303
4304
4305 // ////////////////////////////////////////////////////////////////////////// //
4306 // word termination, locals support
4307 //
4308
4309 // (EXIT)
4310 UFWORD(PAR_EXIT) {
4311   if (ufoRP == 0) longjmp(ufoStopVMJP, 667);
4312   ufoIP = ufoRPop();
4313 }
4314
4315 // (SELF@)
4316 // ( -- self-value )
4317 UFWORD(PAR_SELF_LOAD) {
4318   ufoPush(ufoImgGetU32(ufoAddrSelf));
4319 }
4320
4321 // (SELF!)
4322 // ( self-value -- )
4323 UFWORD(PAR_SELF_STORE) {
4324   const uint32_t val = ufoPop();
4325   ufoImgPutU32(ufoAddrSelf, val);
4326 }
4327
4328 // (L-ENTER)
4329 // ( loccount -- )
4330 UFWORD(PAR_LENTER) {
4331   // low byte of loccount is total number of locals
4332   // high byte is the number of args
4333   uint32_t lcount = ufoImgGetU32(ufoIP); ufoIP += 4u;
4334   uint32_t acount = (lcount >> 8) & 0xff;
4335   lcount &= 0xff;
4336   if (lcount == 0 || lcount < acount) ufoFatal("invalid call to (L-ENTER)");
4337   if ((ufoLBP != 0 && ufoLBP >= ufoLP) || UFO_LSTACK_SIZE - ufoLP <= lcount + 2) {
4338     ufoFatal("out of locals stack");
4339   }
4340   uint32_t newbp;
4341   if (ufoLP == 0) { ufoLP = 1; newbp = 1; } else newbp = ufoLP;
4342   //fprintf(stderr, "LP: %u; LBP: %u; locs: %u; word: %s\n", ufoLP, ufoLBP, fw->locs, fw->name);
4343   ufoLStack[ufoLP] = ufoLBP; ufoLP += 1;
4344   ufoLBP = newbp; ufoLP += lcount;
4345   // and copy args
4346   newbp += acount;
4347   while (newbp != ufoLBP) {
4348     ufoLStack[newbp] = ufoPop();
4349     newbp -= 1;
4350   }
4351 }
4352
4353 // (L-LEAVE)
4354 UFWORD(PAR_LLEAVE) {
4355   if (ufoLBP == 0) ufoFatal("(L-LEAVE) with empty locals stack");
4356   if (ufoLBP >= ufoLP) ufoFatal("(L-LEAVE) broken locals stack");
4357   ufoLP = ufoLBP;
4358   ufoLBP = ufoLStack[ufoLBP];
4359 }
4360
4361 //==========================================================================
4362 //
4363 //  ufoLoadLocal
4364 //
4365 //==========================================================================
4366 UFO_FORCE_INLINE void ufoLoadLocal (const uint32_t lidx) {
4367   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index");
4368   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
4369   ufoPush(ufoLStack[ufoLBP + lidx]);
4370 }
4371
4372 //==========================================================================
4373 //
4374 //  ufoStoreLocal
4375 //
4376 //==========================================================================
4377 UFO_FORCE_INLINE void ufoStoreLocal (const uint32_t lidx) {
4378   const uint32_t value = ufoPop();
4379   if (lidx == 0 || lidx >= UFO_LSTACK_SIZE) ufoFatal("invalid local index");
4380   if (ufoLBP == 0 || ufoLBP >= ufoLP || ufoLP - ufoLBP <= lidx) ufoFatal("invalid local index");
4381   ufoLStack[ufoLBP + lidx] = value;
4382 }
4383
4384 // (LOCAL@)
4385 // ( idx -- value )
4386 UFWORD(PAR_LOCAL_LOAD) { ufoLoadLocal(ufoPop()); }
4387
4388 // (LOCAL!)
4389 // ( value idx -- )
4390 UFWORD(PAR_LOCAL_STORE) { ufoStoreLocal(ufoPop()); }
4391
4392
4393 // ////////////////////////////////////////////////////////////////////////// //
4394 // stack manipulation
4395 //
4396
4397 // DUP
4398 // ( n -- n n )
4399 UFWORD(DUP) { ufoDup(); }
4400 // NIP
4401 // ( a b -- b )
4402 UFWORD(NIP) {
4403   UFO_STACK(2);
4404   const uint32_t b = UFO_TOS;
4405   ufoSP -= 1;
4406   UFO_TOS = b;
4407 }
4408 // TUCK
4409 // ( a b -- b a b )
4410 UFWORD(TUCK) {
4411   const uint32_t b = ufoPop();
4412   const uint32_t a = ufoPop();
4413   ufoPush(b); ufoPush(a); ufoPush(b);
4414 }
4415 // ?DUP
4416 // ( n -- n n ) | ( 0 -- 0 )
4417 UFWORD(QDUP) {
4418   UFO_STACK(1);
4419   const uint32_t n = UFO_TOS;
4420   if (n) ufoPush(n);
4421 }
4422 // 2DUP
4423 // ( n0 n1 -- n0 n1 n0 n1 )
4424 UFWORD(DDUP) { ufo2Dup(); }
4425 // DROP
4426 // ( n -- )
4427 UFWORD(DROP) { ufoDrop(); }
4428 // 2DROP
4429 // ( n0 n1 -- )
4430 UFWORD(DDROP) { ufo2Drop(); }
4431 // SWAP
4432 // ( n0 n1 -- n1 n0 )
4433 UFWORD(SWAP) { ufoSwap(); }
4434 // 2SWAP
4435 // ( n0 n1 -- n1 n0 )
4436 UFWORD(DSWAP) { ufo2Swap(); }
4437 // OVER
4438 // ( n0 n1 -- n0 n1 n0 )
4439 UFWORD(OVER) { ufoOver(); }
4440 // 2OVER
4441 // ( n0 n1 -- n0 n1 n0 )
4442 UFWORD(DOVER) { ufo2Over(); }
4443 // ROT
4444 // ( n0 n1 n2 -- n1 n2 n0 )
4445 UFWORD(ROT) { ufoRot(); }
4446 // NROT
4447 // ( n0 n1 n2 -- n2 n0 n1 )
4448 UFWORD(NROT) { ufoNRot(); }
4449
4450 // RDUP
4451 // ( n -- n n )
4452 UFWORD(RDUP) { ufoRDup(); }
4453 // RDROP
4454 // ( n -- )
4455 UFWORD(RDROP) { ufoRDrop(); }
4456
4457 // >R
4458 // ( n -- | n )
4459 UFWORD(DTOR) { ufoRPush(ufoPop()); }
4460 // R>
4461 // ( | n -- n )
4462 UFWORD(RTOD) { ufoPush(ufoRPop()); }
4463 // R@
4464 // ( | n -- n | n )
4465 UFWORD(RPEEK) { ufoPush(ufoRPeek()); }
4466 // 2RDROP
4467 // ( | n n -- )
4468 UFWORD(2RDROP) {
4469   UFO_RSTACK(2);
4470   ufoRP -= 2u;
4471 }
4472 // 2>R
4473 // ( a b | -- | a b )
4474 UFWORD(2DTOR) {
4475   const uint32_t b = ufoPop();
4476   const uint32_t a = ufoPop();
4477   ufoRPush(a);
4478   ufoRPush(b);
4479 }
4480 // 2R>
4481 // ( | a b -- a b | )
4482 UFWORD(2RTOD) {
4483   const uint32_t b = ufoRPop();
4484   const uint32_t a = ufoRPop();
4485   ufoPush(a);
4486   ufoPush(b);
4487 }
4488 // 2R@
4489 // ( | a b -- a b | a b )
4490 UFWORD(2RPEEK) {
4491   UFO_RSTACK(2);
4492   ufoPush(UFO_R(1));
4493   ufoPush(UFO_RTOS);
4494 }
4495
4496 // PICK
4497 // ( idx -- n )
4498 UFWORD(PICK) {
4499   const uint32_t n = ufoPop();
4500   if (n >= ufoSP) ufoFatal("invalid PICK index %u", n);
4501   ufoPush(ufoDStack[ufoSP - n - 1u]);
4502 }
4503
4504 // RPICK
4505 // ( idx -- n )
4506 UFWORD(RPICK) {
4507   const uint32_t n = ufoPop();
4508   if (n >= ufoRP) ufoFatal("invalid RPICK index %u", n);
4509   const uint32_t rp = ufoRP - n - 1u;
4510   ufoPush(ufoRStack[rp]);
4511 }
4512
4513 // ROLL
4514 // ( idx -- n )
4515 UFWORD(ROLL) {
4516   const uint32_t n = ufoPop();
4517   if (n >= ufoSP) ufoFatal("invalid ROLL index %u", n);
4518   switch (n) {
4519     case 0: break; // do nothing
4520     case 1: ufoSwap(); break;
4521     case 2: ufoRot(); break;
4522     default:
4523       {
4524         const uint32_t val = ufoDStack[ufoSP - n - 1u];
4525         for (uint32_t f = ufoSP - n; f < ufoSP; f += 1) ufoDStack[f - 1] = ufoDStack[f];
4526         ufoDStack[ufoSP - 1u] = val;
4527       }
4528       break;
4529   }
4530 }
4531
4532 // RROLL
4533 // ( idx -- n )
4534 UFWORD(RROLL) {
4535   const uint32_t n = ufoPop();
4536   if (n >= ufoRP) ufoFatal("invalid RROLL index %u", n);
4537   if (n != 0) {
4538     const uint32_t rp = ufoRP - n - 1u;
4539     const uint32_t val = ufoRStack[rp];
4540     for (uint32_t f = rp + 1u; f < ufoRP; f += 1u) ufoRStack[f - 1u] = ufoRStack[f];
4541     ufoRStack[ufoRP - 1u] = val;
4542   }
4543 }
4544
4545 // RSWAP
4546 // ( | a b -- | b a )
4547 UFWORD(RSWAP) {
4548   UFO_RSTACK(2);
4549   const uint32_t b = UFO_RTOS;
4550   const uint32_t a = UFO_R(1);
4551   UFO_RTOS = a;
4552   UFO_R(1) = b;
4553 }
4554
4555 // ROVER
4556 // ( | a b -- | a b a )
4557 UFWORD(ROVER) {
4558   UFO_RSTACK(2);
4559   const uint32_t a = UFO_R(1);
4560   ufoRPush(a);
4561 }
4562
4563 // RROT
4564 // ( | a b c -- | b c a )
4565 UFWORD(RROT) {
4566   UFO_RSTACK(3);
4567   const uint32_t c = UFO_RTOS;
4568   const uint32_t b = UFO_R(1);
4569   const uint32_t a = UFO_R(2);
4570   UFO_R(2) = b;
4571   UFO_R(1) = c;
4572   UFO_RTOS = a;
4573 }
4574
4575 // RNROT
4576 // ( | a b c -- | c a b )
4577 UFWORD(RNROT) {
4578   UFO_RSTACK(3);
4579   const uint32_t c = UFO_RTOS;
4580   const uint32_t b = UFO_R(1);
4581   const uint32_t a = UFO_R(2);
4582   UFO_R(2) = c;
4583   UFO_R(1) = a;
4584   UFO_RTOS = b;
4585 }
4586
4587
4588 // ////////////////////////////////////////////////////////////////////////// //
4589 // TIB API
4590 //
4591
4592 // REFILL
4593 // ( -- eofflag )
4594 UFWORD(REFILL) {
4595   ufoPushBool(ufoLoadNextLine(1));
4596 }
4597
4598 // REFILL-NOCROSS
4599 // ( -- eofflag )
4600 UFWORD(REFILL_NOCROSS) {
4601   ufoPushBool(ufoLoadNextLine(0));
4602 }
4603
4604 // (TIB-IN)
4605 // ( -- addr )
4606 UFWORD(TIB_IN) {
4607   ufoPush(ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx));
4608 }
4609
4610 // TIB-PEEKCH
4611 // ( -- char )
4612 UFWORD(TIB_PEEKCH) {
4613   ufoPush(ufoTibPeekCh());
4614 }
4615
4616 // TIB-PEEKCH-OFS
4617 // ( ofs -- char )
4618 UFWORD(TIB_PEEKCH_OFS) {
4619   const uint32_t ofs = ufoPop();
4620   ufoPush(ufoTibPeekChOfs(ofs));
4621 }
4622
4623 // TIB-GETCH
4624 // ( -- char )
4625 UFWORD(TIB_GETCH) {
4626   ufoPush(ufoTibGetCh());
4627 }
4628
4629 // TIB-SKIPCH
4630 // ( -- )
4631 UFWORD(TIB_SKIPCH) {
4632   ufoTibSkipCh();
4633 }
4634
4635
4636 // ////////////////////////////////////////////////////////////////////////// //
4637 // TIB parsing
4638 //
4639
4640 //==========================================================================
4641 //
4642 //  ufoIsDelim
4643 //
4644 //==========================================================================
4645 UFO_FORCE_INLINE int ufoIsDelim (uint8_t ch, uint8_t delim) {
4646   return (delim == 32 ? (ch <= 32) : (ch == delim));
4647 }
4648
4649 // (PARSE)
4650 // ( delim skip-leading-delim? -- addr count TRUE / FALSE )
4651 // does base TIB parsing; never copies anything.
4652 // as our reader is line-based, returns FALSE on EOL.
4653 // EOL is detected after skipping leading delimiters.
4654 // passing -1 as delimiter skips the whole line, and always returns FALSE.
4655 // trailing delimiter is always skipped.
4656 UFWORD(PAR_PARSE) {
4657   const uint32_t skipDelim = ufoPop();
4658   const uint32_t delim = ufoPop();
4659   uint8_t ch;
4660
4661   if (delim == 0 || delim > 0xffU) {
4662     // skip everything
4663     while (ufoTibGetCh() != 0) {}
4664     ufoPushBool(0);
4665   } else {
4666     ch = ufoTibPeekCh();
4667     // skip initial delimiters
4668     if (skipDelim) {
4669       while (ch != 0 && ufoIsDelim(ch, delim)) {
4670         ufoTibSkipCh();
4671         ch = ufoTibPeekCh();
4672       }
4673     }
4674     if (ch == 0) {
4675       ufoPushBool(0);
4676     } else {
4677       // parse
4678       const uint32_t staddr = ufoImgGetU32(ufoAddrTIBx) + ufoImgGetU32(ufoAddrINx);
4679       uint32_t count = 0;
4680       while (ch != 0 && !ufoIsDelim(ch, delim)) {
4681         count += 1u;
4682         ufoTibSkipCh();
4683         ch = ufoTibPeekCh();
4684       }
4685       // skip delimiter
4686       if (ch != 0) ufoTibSkipCh();
4687       ufoPush(staddr);
4688       ufoPush(count);
4689       ufoPushBool(1);
4690     }
4691   }
4692 }
4693
4694 // PARSE-SKIP-BLANKS
4695 // ( -- )
4696 UFWORD(PARSE_SKIP_BLANKS) {
4697   uint8_t ch = ufoTibPeekCh();
4698   while (ch != 0 && ch <= 32) {
4699     ufoTibSkipCh();
4700     ch = ufoTibPeekCh();
4701   }
4702 }
4703
4704 //==========================================================================
4705 //
4706 //  ufoParseMLComment
4707 //
4708 //  initial two chars are skipped
4709 //
4710 //==========================================================================
4711 static void ufoParseMLComment (uint32_t allowMulti, int nested) {
4712   uint32_t level = 1;
4713   uint8_t ch, ch1;
4714   while (level != 0) {
4715     ch = ufoTibGetCh();
4716     if (ch == 0) {
4717       if (allowMulti) {
4718         UFCALL(REFILL_NOCROSS);
4719         if (ufoPop() == 0) ufoFatal("unexpected end of file in comment");
4720       } else {
4721         ufoFatal("unexpected end of line in comment");
4722       }
4723     } else {
4724       ch1 = ufoTibPeekCh();
4725       if (nested && ch == '(' && ch1 == '(') { ufoTibSkipCh(); level += 1; }
4726       else if (nested && ch == ')' && ch1 == ')') { ufoTibSkipCh(); level -= 1; }
4727       else if (!nested && ch == '*' && ch1 == ')') { ufo_assert(level == 1); ufoTibSkipCh(); level = 0; }
4728     }
4729   }
4730 }
4731
4732 // (PARSE-SKIP-COMMENTS)
4733 // ( allow-multiline? -- )
4734 // skip all blanks and comments
4735 UFWORD(PAR_PARSE_SKIP_COMMENTS) {
4736   const uint32_t allowMulti = ufoPop();
4737   uint8_t ch, ch1;
4738   ch = ufoTibPeekCh();
4739   #if 0
4740   fprintf(stderr, "(PARSE-SKIP-COMMENTS): first-ch:'%c'\n", (char)ch);
4741   #endif
4742   while (ch != 0) {
4743     if (ch <= 32) {
4744       ufoTibSkipCh();
4745       ch = ufoTibPeekCh();
4746       #if 0
4747       fprintf(stderr, "(PARSE-SKIP-COMMENTS): blank-ch:'%c'\n", (char)ch);
4748       #endif
4749     } else if (ch == '(') {
4750       #if 0
4751       fprintf(stderr, "(PARSE-SKIP-COMMENTS): ch:'%c'; ch1:'%c' ('%c')\n", (char)ch, (char)ch1,
4752               ufoTibPeekChOfs(0));
4753       #endif
4754       ch1 = ufoTibPeekChOfs(1);
4755       if (ch1 <= 32) {
4756         // single-line comment
4757         do { ch = ufoTibGetCh(); } while (ch != 0 && ch != ')');
4758         ch = ufoTibPeekCh();
4759       } else if ((ch1 == '*' || ch1 == '(') && ufoTibPeekChOfs(2) <= 32) {
4760         // possibly multiline
4761         ufoTibSkipCh(); ufoTibSkipCh(); // skip opening
4762         ufoParseMLComment(allowMulti, (ch1 == '('));
4763         ch = ufoTibPeekCh();
4764       } else {
4765         ch = 0;
4766       }
4767     } else if (ch == '\\' && ufoTibPeekChOfs(1) <= 32) {
4768       // single-line comment
4769       while (ch != 0) ch = ufoTibGetCh();
4770     } else if (ch == '-' && ufoTibPeekChOfs(1) == ch && ufoTibPeekChOfs(2) <= 32) {
4771       // skip to EOL
4772       while (ch != 0) ch = ufoTibGetCh();
4773     } else if ((ch == ';' || ch == '/') && ufoTibPeekChOfs(1) == ch) {
4774       // skip to EOL
4775       while (ch != 0) ch = ufoTibGetCh();
4776     } else {
4777       ch = 0;
4778     }
4779   }
4780   #if 0
4781   fprintf(stderr, "(PARSE-SKIP-COMMENTS): end-ch:'%c'\n", ufoTibPeekCh());
4782   #endif
4783 }
4784
4785 // PARSE-SKIP-LINE
4786 // ( -- )
4787 UFWORD(PARSE_SKIP_LINE) {
4788   ufoPush(0); ufoPushBool(0); UFCALL(PAR_PARSE);
4789   if (ufoPop() != 0) {
4790     ufo2Drop();
4791   }
4792 }
4793
4794 // PARSE-NAME
4795 // ( -- addr count )
4796 // parse with leading blanks skipping. doesn't copy anything.
4797 // return empty string on EOL.
4798 UFWORD(PARSE_NAME) {
4799   ufoPush(32); ufoPushBool(1); UFCALL(PAR_PARSE);
4800   if (ufoPop() == 0) {
4801     ufoPush(0);
4802     ufoPush(0);
4803   }
4804 }
4805
4806 // PARSE
4807 // ( delim -- addr count TRUE / FALSE )
4808 // parse without skipping delimiters; never copies anything.
4809 // as our reader is line-based, returns FALSE on EOL.
4810 // passing 0 as delimiter skips the whole line, and always returns FALSE.
4811 // trailing delimiter is always skipped.
4812 UFWORD(PARSE) {
4813   ufoPushBool(0); UFCALL(PAR_PARSE);
4814 }
4815
4816
4817 // ////////////////////////////////////////////////////////////////////////// //
4818 // char output
4819 //
4820
4821 // (NORM-EMIT-CHAR)
4822 // ( ch -- )
4823 UFWORD(PAR_NORM_EMIT_CHAR) {
4824   uint32_t ch = ufoPop()&0xffU;
4825   if (ch < 32 || ch == 127) {
4826     if (ch != 9 && ch != 10 && ch != 13) ch = '?';
4827   }
4828   ufoPush(ch);
4829 }
4830
4831 // (NORM-XEMIT-CHAR)
4832 // ( ch -- )
4833 UFWORD(PAR_NORM_XEMIT_CHAR) {
4834   uint32_t ch = ufoPop()&0xffU;
4835   if (ch < 32 || ch == 127) ch = '?';
4836   ufoPush(ch);
4837 }
4838
4839 // (EMIT)
4840 // ( n -- )
4841 UFWORD(PAR_EMIT) {
4842   uint32_t ch = ufoPop()&0xffU;
4843   ufoLastEmitWasCR = (ch == 10);
4844   putchar((char)ch);
4845 }
4846
4847 // LASTCR?
4848 // ( -- bool )
4849 UFWORD(LASTCRQ) {
4850   ufoPushBool(ufoLastEmitWasCR);
4851 }
4852
4853 // LASTCR!
4854 // ( bool -- )
4855 UFWORD(LASTCRSET) {
4856   ufoLastEmitWasCR = !!ufoPop();
4857 }
4858
4859 // FLUSH-EMIT
4860 // ( -- )
4861 UFWORD(FLUSH_EMIT) {
4862   ufoFlushOutput();
4863 }
4864
4865
4866 // ////////////////////////////////////////////////////////////////////////// //
4867 // simple math
4868 //
4869
4870 #define UF_UMATH(name_,op_)  \
4871 UFWORD(name_) { \
4872   const uint32_t a = ufoPop(); \
4873   ufoPush(op_); \
4874 }
4875
4876 #define UF_BMATH(name_,op_)  \
4877 UFWORD(name_) { \
4878   const uint32_t b = ufoPop(); \
4879   const uint32_t a = ufoPop(); \
4880   ufoPush(op_); \
4881 }
4882
4883 #define UF_BDIV(name_,op_)  \
4884 UFWORD(name_) { \
4885   const uint32_t b = ufoPop(); \
4886   const uint32_t a = ufoPop(); \
4887   if (b == 0) ufoFatal("division by zero"); \
4888   ufoPush(op_); \
4889 }
4890
4891 #define UFO_POP_U64()  ({ \
4892   const uint32_t hi_ = ufoPop(); \
4893   const uint32_t lo_ = ufoPop(); \
4894   (((uint64_t)hi_ << 32) | lo_); \
4895 })
4896
4897 // this is UB by the idiotic C standard. i don't care.
4898 #define UFO_POP_I64()  ((int64_t)UFO_POP_U64())
4899
4900 #define UFO_PUSH_U64(vn_)  do { \
4901   ufoPush((uint32_t)(vn_)); \
4902   ufoPush((uint32_t)((vn_) >> 32)); \
4903 } while (0)
4904
4905 // this is UB by the idiotic C standard. i don't care.
4906 #define UFO_PUSH_I64(vn_)  UFO_PUSH_U64((uint64_t)(vn_))
4907
4908 // +
4909 // ( a b -- a+b )
4910 UF_BMATH(PLUS, a + b);
4911
4912 // -
4913 // ( a b -- a-b )
4914 UF_BMATH(MINUS, a - b);
4915
4916 // *
4917 // ( a b -- a*b )
4918 UF_BMATH(MUL, (uint32_t)((int32_t)a * (int32_t)b));
4919
4920 // U*
4921 // ( a b -- a*b )
4922 UF_BMATH(UMUL, a * b);
4923
4924 // /
4925 // ( a b -- a/b )
4926 UF_BDIV(DIV, (uint32_t)((int32_t)a / (int32_t)b));
4927
4928 // U/
4929 // ( a b -- a/b )
4930 UF_BDIV(UDIV, a / b);
4931
4932 // MOD
4933 // ( a b -- a%b )
4934 UF_BDIV(MOD, (uint32_t)((int32_t)a % (int32_t)b));
4935
4936 // UMOD
4937 // ( a b -- a%b )
4938 UF_BDIV(UMOD, a % b);
4939
4940 // /MOD
4941 // ( a b -- a/b, a%b )
4942 UFWORD(DIVMOD) {
4943   const int32_t b = (int32_t)ufoPop();
4944   const int32_t a = (int32_t)ufoPop();
4945   if (b == 0) ufoFatal("division by zero");
4946   ufoPush((uint32_t)(a/b));
4947   ufoPush((uint32_t)(a%b));
4948 }
4949
4950 // U/MOD
4951 // ( a b -- a/b, a%b )
4952 UFWORD(UDIVMOD) {
4953   const uint32_t b = ufoPop();
4954   const uint32_t a = ufoPop();
4955   if (b == 0) ufoFatal("division by zero");
4956   ufoPush((uint32_t)(a/b));
4957   ufoPush((uint32_t)(a%b));
4958 }
4959
4960 // */
4961 // ( a b c -- a*b/c )
4962 // this uses 64-bit intermediate value
4963 UFWORD(MULDIV) {
4964   const int32_t c = (int32_t)ufoPop();
4965   const int32_t b = (int32_t)ufoPop();
4966   const int32_t a = (int32_t)ufoPop();
4967   if (c == 0) ufoFatal("division by zero");
4968   int64_t xval = a; xval *= b; xval /= c;
4969   ufoPush((uint32_t)(int32_t)xval);
4970 }
4971
4972 // U*/
4973 // ( a b c -- a*b/c )
4974 // this uses 64-bit intermediate value
4975 UFWORD(UMULDIV) {
4976   const uint32_t c = ufoPop();
4977   const uint32_t b = ufoPop();
4978   const uint32_t a = ufoPop();
4979   if (c == 0) ufoFatal("division by zero");
4980   uint64_t xval = a; xval *= b; xval /= c;
4981   ufoPush((uint32_t)xval);
4982 }
4983
4984 // */MOD
4985 // ( a b c -- a*b/c a*b%c )
4986 // this uses 64-bit intermediate value
4987 UFWORD(MULDIVMOD) {
4988   const int32_t c = (int32_t)ufoPop();
4989   const int32_t b = (int32_t)ufoPop();
4990   const int32_t a = (int32_t)ufoPop();
4991   if (c == 0) ufoFatal("division by zero");
4992   int64_t xval = a; xval *= b;
4993   ufoPush((uint32_t)(int32_t)(xval / c));
4994   ufoPush((uint32_t)(int32_t)(xval % c));
4995 }
4996
4997 // U*/
4998 // ( a b c -- a*b/c )
4999 // this uses 64-bit intermediate value
5000 UFWORD(UMULDIVMOD) {
5001   const uint32_t c = ufoPop();
5002   const uint32_t b = ufoPop();
5003   const uint32_t a = ufoPop();
5004   if (c == 0) ufoFatal("division by zero");
5005   uint64_t xval = a; xval *= b;
5006   ufoPush((uint32_t)(xval / c));
5007   ufoPush((uint32_t)(xval % c));
5008 }
5009
5010 // M*
5011 // ( a b -- lo(a*b) hi(a*b) )
5012 // this leaves 64-bit result
5013 UFWORD(MMUL) {
5014   const int32_t b = (int32_t)ufoPop();
5015   const int32_t a = (int32_t)ufoPop();
5016   int64_t xval = a; xval *= b;
5017   UFO_PUSH_I64(xval);
5018 }
5019
5020 // UM*
5021 // ( a b -- lo(a*b) hi(a*b) )
5022 // this leaves 64-bit result
5023 UFWORD(UMMUL) {
5024   const uint32_t b = ufoPop();
5025   const uint32_t a = ufoPop();
5026   uint64_t xval = a; xval *= b;
5027   UFO_PUSH_U64(xval);
5028 }
5029
5030 // M/MOD
5031 // ( alo ahi b -- a/b a%b )
5032 UFWORD(MDIVMOD) {
5033   const int32_t b = (int32_t)ufoPop();
5034   if (b == 0) ufoFatal("division by zero");
5035   int64_t a = UFO_POP_I64();
5036   int32_t adiv = (int32_t)(a / b);
5037   int32_t amod = (int32_t)(a % b);
5038   ufoPush((uint32_t)adiv);
5039   ufoPush((uint32_t)amod);
5040 }
5041
5042 // UM/MOD
5043 // ( alo ahi b -- a/b a%b )
5044 UFWORD(UMDIVMOD) {
5045   const uint32_t b = ufoPop();
5046   if (b == 0) ufoFatal("division by zero");
5047   uint64_t a = UFO_POP_U64();
5048   uint32_t adiv = (uint32_t)(a / b);
5049   uint32_t amod = (uint32_t)(a % b);
5050   ufoPush(adiv);
5051   ufoPush(amod);
5052 }
5053
5054 // UDS*
5055 // ( alo ahi u -- lo hi )
5056 UFWORD(UDSMUL) {
5057   const uint32_t b = ufoPop();
5058   uint64_t a = UFO_POP_U64();
5059   a *= b;
5060   UFO_PUSH_U64(a);
5061 }
5062
5063 // D-
5064 // ( lo0 hi0 lo1 hi1 -- lo hi )
5065 UFWORD(DMINUS) {
5066   uint64_t n1 = UFO_POP_U64();
5067   uint64_t n0 = UFO_POP_U64();
5068   n0 -= n1;
5069   UFO_PUSH_U64(n0);
5070 }
5071
5072 // D+
5073 // ( lo0 hi0 lo1 hi1 -- lo hi )
5074 UFWORD(DPLUS) {
5075   uint64_t n1 = UFO_POP_U64();
5076   uint64_t n0 = UFO_POP_U64();
5077   n0 += n1;
5078   UFO_PUSH_U64(n0);
5079 }
5080
5081 // D=
5082 // ( lo0 hi0 lo1 hi1 -- bool )
5083 UFWORD(DEQU) {
5084   uint64_t n1 = UFO_POP_U64();
5085   uint64_t n0 = UFO_POP_U64();
5086   ufoPushBool(n0 == n1);
5087 }
5088
5089 // D<
5090 // ( lo0 hi0 lo1 hi1 -- bool )
5091 UFWORD(DLESS) {
5092   int64_t n1 = UFO_POP_I64();
5093   int64_t n0 = UFO_POP_I64();
5094   ufoPushBool(n0 < n1);
5095 }
5096
5097 // D<=
5098 // ( lo0 hi0 lo1 hi1 -- bool )
5099 UFWORD(DLESSEQU) {
5100   int64_t n1 = UFO_POP_I64();
5101   int64_t n0 = UFO_POP_I64();
5102   ufoPushBool(n0 <= n1);
5103 }
5104
5105 // DU<
5106 // ( lo0 hi0 lo1 hi1 -- bool )
5107 UFWORD(DULESS) {
5108   uint64_t n1 = UFO_POP_U64();
5109   uint64_t n0 = UFO_POP_U64();
5110   ufoPushBool(n0 < n1);
5111 }
5112
5113 // DU<=
5114 // ( lo0 hi0 lo1 hi1 -- bool )
5115 UFWORD(DULESSEQU) {
5116   uint64_t n1 = UFO_POP_U64();
5117   uint64_t n0 = UFO_POP_U64();
5118   ufoPushBool(n0 <= n1);
5119 }
5120
5121 // SM/REM
5122 // ( dlo dhi n -- nmod ndiv )
5123 // rounds toward zero
5124 UFWORD(SMREM) {
5125   const int32_t n = (int32_t)ufoPop();
5126   if (n == 0) ufoFatal("division by zero");
5127   int64_t d = UFO_POP_I64();
5128   int32_t ndiv = (int32_t)(d / n);
5129   int32_t nmod = (int32_t)(d % n);
5130   ufoPush(nmod);
5131   ufoPush(ndiv);
5132 }
5133
5134 // FM/MOD
5135 // ( dlo dhi n -- nmod ndiv )
5136 // rounds toward negative infinity
5137 UFWORD(FMMOD) {
5138   const int32_t n = (int32_t)ufoPop();
5139   if (n == 0) ufoFatal("division by zero");
5140   int64_t d = UFO_POP_I64();
5141   int32_t ndiv = (int32_t)(d / n);
5142   int32_t nmod = (int32_t)(d % n);
5143   if (nmod != 0 && ((uint32_t)n ^ (uint32_t)(d >> 32)) >= 0x80000000u) {
5144     ndiv -= 1;
5145     nmod += n;
5146   }
5147   ufoPush(nmod);
5148   ufoPush(ndiv);
5149 }
5150
5151
5152 // ////////////////////////////////////////////////////////////////////////// //
5153 // simple logic and bit manipulation
5154 //
5155
5156 #define UF_CMP(name_,op_)  \
5157 UFWORD(name_) { \
5158   const uint32_t b = ufoPop(); \
5159   const uint32_t a = ufoPop(); \
5160   ufoPushBool(op_); \
5161 }
5162
5163 // <
5164 // ( a b -- a<b )
5165 UF_CMP(LESS, (int32_t)a < (int32_t)b);
5166
5167 // U<
5168 // ( a b -- a<b )
5169 UF_CMP(ULESS, a < b);
5170
5171 // >
5172 // ( a b -- a>b )
5173 UF_CMP(GREAT, (int32_t)a > (int32_t)b);
5174
5175 // U>
5176 // ( a b -- a>b )
5177 UF_CMP(UGREAT, a > b);
5178
5179 // <=
5180 // ( a b -- a<=b )
5181 UF_CMP(LESSEQU, (int32_t)a <= (int32_t)b);
5182
5183 // U<=
5184 // ( a b -- a<=b )
5185 UF_CMP(ULESSEQU, a <= b);
5186
5187 // >=
5188 // ( a b -- a>=b )
5189 UF_CMP(GREATEQU, (int32_t)a >= (int32_t)b);
5190
5191 // U>=
5192 // ( a b -- a>=b )
5193 UF_CMP(UGREATEQU, a >= b);
5194
5195 // =
5196 // ( a b -- a=b )
5197 UF_CMP(EQU, a == b);
5198
5199 // <>
5200 // ( a b -- a<>b )
5201 UF_CMP(NOTEQU, a != b);
5202
5203 // 0=
5204 // ( a -- a==0 )
5205 UFWORD(ZERO_EQU) {
5206   const uint32_t a = ufoPop();
5207   ufoPushBool(a == 0);
5208 }
5209
5210 // 0<>
5211 // ( a -- a<>0 )
5212 UFWORD(ZERO_NOTEQU) {
5213   const uint32_t a = ufoPop();
5214   ufoPushBool(a != 0);
5215 }
5216
5217 // LAND
5218 // ( a b -- a&&b )
5219 UF_CMP(LOGAND, a && b);
5220
5221 // LOR
5222 // ( a b -- a||b )
5223 UF_CMP(LOGOR, a || b);
5224
5225 // AND
5226 // ( a b -- a&b )
5227 UFWORD(AND) {
5228   const uint32_t b = ufoPop();
5229   const uint32_t a = ufoPop();
5230   ufoPush(a&b);
5231 }
5232
5233 // OR
5234 // ( a b -- a|b )
5235 UFWORD(OR) {
5236   const uint32_t b = ufoPop();
5237   const uint32_t a = ufoPop();
5238   ufoPush(a|b);
5239 }
5240
5241 // XOR
5242 // ( a b -- a^b )
5243 UFWORD(XOR) {
5244   const uint32_t b = ufoPop();
5245   const uint32_t a = ufoPop();
5246   ufoPush(a^b);
5247 }
5248
5249 // (LIT-AND)
5250 // ( a -- a&[ip] )
5251 UFWORD(LIT_AND) {
5252   UFO_STACK(1);
5253   UFO_TOS &= ufoImgGetU32(ufoIP); ufoIP += 4u;
5254 }
5255
5256 // (LIT-~AND)
5257 // ( a -- a&~[ip] )
5258 UFWORD(LIT_NAND) {
5259   UFO_STACK(1);
5260   UFO_TOS &= ~ufoImgGetU32(ufoIP); ufoIP += 4u;
5261 }
5262
5263 // (LIT-OR)
5264 // ( a -- a|[ip] )
5265 UFWORD(LIT_OR) {
5266   UFO_STACK(1);
5267   UFO_TOS |= ufoImgGetU32(ufoIP); ufoIP += 4u;
5268 }
5269
5270 // (LIT-XOR)
5271 // ( a -- a^[ip] )
5272 UFWORD(LIT_XOR) {
5273   UFO_STACK(1);
5274   UFO_TOS ^= ufoImgGetU32(ufoIP); ufoIP += 4u;
5275 }
5276
5277
5278 // BITNOT
5279 // ( a -- ~a )
5280 UFWORD(BITNOT) {
5281   const uint32_t a = ufoPop();
5282   ufoPush(~a);
5283 }
5284
5285 // ASH
5286 // ( n count -- )
5287 // arithmetic shift; positive `n` shifts to the left
5288 UFWORD(ASH) {
5289   int32_t c = (int32_t)ufoPop();
5290   if (c < 0) {
5291     // right
5292     int32_t n = (int32_t)ufoPop();
5293     if (c >= -30) {
5294       n >>= (uint8_t)(-c);
5295     } else {
5296       if (n < 0) n = -1; else n = 0;
5297     }
5298     ufoPush((uint32_t)n);
5299   } else if (c > 0) {
5300     // left
5301     uint32_t u = ufoPop();
5302     if (c <= 31) {
5303       u <<= (uint8_t)c;
5304     } else {
5305       u = 0;
5306     }
5307     ufoPush(u);
5308   }
5309 }
5310
5311 // LSH
5312 // ( n count -- )
5313 // logical shift; positive `n` shifts to the left
5314 UFWORD(LSH) {
5315   int32_t c = (int32_t) ufoPop();
5316   uint32_t u = ufoPop();
5317   if (c < 0) {
5318     // right
5319     if (c >= -31) {
5320       u >>= (uint8_t)(-c);
5321     } else {
5322       u = 0;
5323     }
5324   } else if (c > 0) {
5325     // left
5326     if (c <= 31) {
5327       u <<= (uint8_t)c;
5328     } else {
5329       u = 0;
5330     }
5331   }
5332   ufoPush(u);
5333 }
5334
5335 // ARSHIFT
5336 // ( n count -- )
5337 // arithmetic shift right
5338 UFWORD(ARSHIFT) {
5339   int32_t c = (int32_t)ufoPop();
5340   if (c >= 0) {
5341     int32_t n = (int32_t)ufoPop();
5342     if (c <= 30) {
5343       n >>= (uint8_t)(c);
5344     } else {
5345       if (n < 0) n = -1; else n = 0;
5346     }
5347     ufoPush((uint32_t)n);
5348   } else {
5349     ufoFatal("negative shift");
5350   }
5351 }
5352
5353 // RSHIFT
5354 // ( n count -- )
5355 // logical shift right
5356 UFWORD(RSHIFT) {
5357   uint32_t c = (int32_t)ufoPop();
5358   if (c >= 0) {
5359     uint32_t n = (int32_t)ufoPop();
5360     if (c <= 31) {
5361       n >>= (uint8_t)(c);
5362     } else {
5363       n = 0;
5364     }
5365     ufoPush((uint32_t)n);
5366   } else {
5367     ufoFatal("negative shift");
5368   }
5369 }
5370
5371 // LSHIFT
5372 // ( n count -- )
5373 // logical shift left
5374 UFWORD(LSHIFT) {
5375   int32_t c = (int32_t) ufoPop();
5376   uint32_t u = ufoPop();
5377   if (c >= 0) {
5378     if (c <= 31) {
5379       u <<= (uint8_t)c;
5380     } else {
5381       u = 0;
5382     }
5383     ufoPush(u);
5384   } else {
5385     ufoFatal("negative shift");
5386   }
5387 }
5388
5389 // ~AND
5390 // ( a b -- a&~b )
5391 UFWORD(BN_AND) {
5392   const uint32_t b = ufoPop();
5393   const uint32_t a = ufoPop();
5394   ufoPush(a&~b);
5395 }
5396
5397 // ABS
5398 // ( a -- |a| )
5399 UFWORD(ABS) {
5400   if ((ufoPeek() & 0x80000000) != 0) {
5401     UFO_TOS = ~UFO_TOS + 1u;
5402   }
5403 }
5404
5405 // NEGATE
5406 // ( a -- -a )
5407 UFWORD(NEGATE) {
5408   UFO_STACK(1);
5409   UFO_TOS = ~UFO_TOS + 1u;
5410 }
5411
5412 // SIGN?
5413 // ( n -- -1|0|1 )
5414 UFWORD(SIGNQ) {
5415   const uint32_t a = ufoPop();
5416   if ((a & 0x80000000) != 0) ufoPush(~(uint32_t)0);
5417   else if (a != 0) ufoPush(1);
5418   else ufoPush(0);
5419 }
5420
5421 // LO-WORD
5422 // ( a -- a&0xffff )
5423 UFWORD(LO_WORD) {
5424   UFO_STACK(1);
5425   UFO_TOS &= 0xffffU;
5426 }
5427
5428 // LO-BYTE
5429 // ( a -- a&0xff )
5430 UFWORD(LO_BYTE) {
5431   UFO_STACK(1);
5432   UFO_TOS &= 0xffU;
5433 }
5434
5435 // HI-WORD
5436 // ( a -- (a>>16)&0xffff )
5437 UFWORD(HI_WORD) {
5438   UFO_STACK(1);
5439   UFO_TOS = (UFO_TOS>>16)&0xffffU;
5440 }
5441
5442 // HI-BYTE
5443 // ( a -- (a>>8)&0xff )
5444 UFWORD(HI_BYTE) {
5445   UFO_STACK(1);
5446   UFO_TOS = (UFO_TOS>>8)&0xffU;
5447 }
5448
5449 // MIN
5450 // ( a b -- min[a,b] )
5451 UFWORD(MIN) {
5452   const int32_t b = (int32_t)ufoPop();
5453   UFO_STACK(1);
5454   if ((int32_t)UFO_TOS > b) UFO_TOS = (uint32_t)b;
5455 }
5456
5457 // MAX
5458 // ( a b -- max[a,b] )
5459 UFWORD(MAX) {
5460   const int32_t b = (int32_t)ufoPop();
5461   UFO_STACK(1);
5462   if ((int32_t)UFO_TOS < b) UFO_TOS = (uint32_t)b;
5463 }
5464
5465 // UMIN
5466 // ( a b -- umin[a,b] )
5467 UFWORD(UMIN) {
5468   const uint32_t b = ufoPop();
5469   UFO_STACK(1);
5470   if (UFO_TOS > b) UFO_TOS = b;
5471 }
5472
5473 // UMAX
5474 // ( a b -- umax[a,b] )
5475 UFWORD(UMAX) {
5476   const uint32_t b = ufoPop();
5477   UFO_STACK(1);
5478   if (UFO_TOS < b) UFO_TOS = b;
5479 }
5480
5481 // WITHIN
5482 // ( a lo hi -- a>=lo&&a<hi )
5483 UFWORD(WITHIN) {
5484   //const int32_t hi = (int32_t)ufoPop();
5485   //const int32_t lo = (int32_t)ufoPop();
5486   //const int32_t a = (int32_t)ufoPop();
5487   //ufoPushBool(a >= lo && a < hi);
5488   // sadly, idiotic ANS standard requires this:
5489   const uint32_t hi = ufoPop();
5490   const uint32_t lo = ufoPop();
5491   const uint32_t a = ufoPop();
5492   ufoPushBool(a - lo < hi - lo);
5493 }
5494
5495 // UWITHIN
5496 // ( ua ulo uhi -- ua>=ulo&&ua<uhi )
5497 UFWORD(UWITHIN) {
5498   const uint32_t hi = ufoPop();
5499   const uint32_t lo = ufoPop();
5500   const uint32_t a = ufoPop();
5501   ufoPushBool(a >= lo && a < hi);
5502 }
5503
5504 // BOUNDS?
5505 // ( ua ulo uhi -- ua>=ulo&&ua<=uhi )
5506 UFWORD(BOUNDSQ) {
5507   const uint32_t hi = ufoPop();
5508   const uint32_t lo = ufoPop();
5509   const uint32_t a = ufoPop();
5510   ufoPushBool(a >= lo && a <= hi);
5511 }
5512
5513 // BSWAP16
5514 // ( u -- u )
5515 UFWORD(BSWAP16) {
5516   UFO_STACK(1);
5517   const uint32_t a = UFO_TOS;
5518   UFO_TOS = (uint32_t)__builtin_bswap16((uint16_t)a);
5519 }
5520
5521 // BSWAP32
5522 // ( u -- u )
5523 UFWORD(BSWAP32) {
5524   UFO_STACK(1);
5525   const uint32_t a = UFO_TOS;
5526   UFO_TOS = __builtin_bswap32(a);
5527 }
5528
5529 // (SWAP:1+:SWAP)
5530 // ( a b -- a+1 b )
5531 UFWORD(PAR_SWAP_INC_SWAP) {
5532   UFO_STACK(2);
5533   UFO_S(1) += 1u;
5534 }
5535
5536 // 1+
5537 // ( a -- a+1 )
5538 UFWORD(1ADD) {
5539   UFO_STACK(1);
5540   UFO_TOS += 1u;
5541 }
5542
5543 // 1-
5544 // ( a -- a-1 )
5545 UFWORD(1SUB) {
5546   UFO_STACK(1);
5547   UFO_TOS -= 1u;
5548 }
5549
5550 // 2+
5551 // ( a -- a+2 )
5552 UFWORD(2ADD) {
5553   UFO_STACK(1);
5554   UFO_TOS += 2u;
5555 }
5556
5557 // 2-
5558 // ( a -- a-2 )
5559 UFWORD(2SUB) {
5560   UFO_STACK(1);
5561   UFO_TOS -= 2u;
5562 }
5563
5564 // 4+
5565 // ( a -- a+4 )
5566 UFWORD(4ADD) {
5567   UFO_STACK(1);
5568   UFO_TOS += 4u;
5569 }
5570
5571 // 4-
5572 // ( a -- a-4 )
5573 UFWORD(4SUB) {
5574   UFO_STACK(1);
5575   UFO_TOS -= 4u;
5576 }
5577
5578 // 8+
5579 // ( a -- a+8 )
5580 UFWORD(8ADD) {
5581   UFO_STACK(1);
5582   UFO_TOS += 8u;
5583 }
5584
5585 // 8-
5586 // ( a -- a-8 )
5587 UFWORD(8SUB) {
5588   UFO_STACK(1);
5589   UFO_TOS -= 8u;
5590 }
5591
5592 // +CELLS
5593 // ( a n -- a+n*4 )
5594 UFWORD(ADD_CELLS) {
5595   const uint32_t n = ufoPop();
5596   UFO_STACK(1);
5597   UFO_TOS += n << 2;
5598 }
5599
5600 // -CELLS
5601 // ( a n -- a-n*4 )
5602 UFWORD(SUB_CELLS) {
5603   const uint32_t n = ufoPop();
5604   UFO_STACK(1);
5605   UFO_TOS -= n << 2;
5606 }
5607
5608 // 2*
5609 // ( a -- a<<1 )
5610 UFWORD(2MUL) {
5611   UFO_STACK(1);
5612   UFO_TOS <<= 1;
5613 }
5614
5615 // 4*
5616 // ( a -- a<<2 )
5617 UFWORD(4MUL) {
5618   UFO_STACK(1);
5619   UFO_TOS <<= 2;
5620 }
5621
5622 // 8*
5623 // ( a -- a<<3 )
5624 UFWORD(8MUL) {
5625   UFO_STACK(1);
5626   UFO_TOS <<= 3;
5627 }
5628
5629 // 2/
5630 // ( a -- a>>1 )
5631 UFWORD(2DIV) {
5632   UFO_STACK(1);
5633   UFO_TOS = (uint32_t)((int32_t)UFO_TOS >> 1);
5634 }
5635
5636 // 4/
5637 // ( a -- a>>2 )
5638 UFWORD(4DIV) {
5639   UFO_STACK(1);
5640   UFO_TOS = (uint32_t)((int32_t)UFO_TOS >> 2);
5641 }
5642
5643 // 8/
5644 // ( a -- a>>3 )
5645 UFWORD(8DIV) {
5646   UFO_STACK(1);
5647   UFO_TOS = (uint32_t)((int32_t)UFO_TOS >> 3);
5648 }
5649
5650 // 2U/
5651 // ( a -- a>>1 )
5652 UFWORD(2UDIV) {
5653   UFO_STACK(1);
5654   UFO_TOS >>= 1;
5655 }
5656
5657 // 4U/
5658 // ( a -- a>>2 )
5659 UFWORD(4UDIV) {
5660   UFO_STACK(1);
5661   UFO_TOS >>= 2;
5662 }
5663
5664 // 8U/
5665 // ( a -- a>>3 )
5666 UFWORD(8UDIV) {
5667   UFO_STACK(1);
5668   UFO_TOS >>= 3;
5669 }
5670
5671 // 0<
5672 // ( a -- a<0? )
5673 UFWORD(0LESS) {
5674   UFO_STACK(1);
5675   if ((int32_t)UFO_TOS < 0) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
5676 }
5677
5678 // 0<=
5679 // ( a -- a<=0? )
5680 UFWORD(0LESSEQU) {
5681   UFO_STACK(1);
5682   if ((int32_t)UFO_TOS <= 0) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
5683 }
5684
5685 // 0>
5686 // ( a -- a>0? )
5687 UFWORD(0GREAT) {
5688   UFO_STACK(1);
5689   if ((int32_t)UFO_TOS > 0) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
5690 }
5691
5692 // 0>=
5693 // ( a -- a>=0? )
5694 UFWORD(0GREATEQU) {
5695   UFO_STACK(1);
5696   if ((int32_t)UFO_TOS >= 0) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
5697 }
5698
5699
5700 // ////////////////////////////////////////////////////////////////////////// //
5701 // string unescaping
5702 //
5703
5704 // (UNESCAPE)
5705 // ( addr count -- addr count )
5706 UFWORD(PAR_UNESCAPE) {
5707   const uint32_t count = ufoPop();
5708   const uint32_t addr = ufoPeek();
5709   if ((count & ((uint32_t)1<<31)) == 0) {
5710     const uint32_t eaddr = addr + count;
5711     uint32_t caddr = addr;
5712     uint32_t daddr = addr;
5713     while (caddr != eaddr) {
5714       uint8_t ch = ufoImgGetU8(caddr); caddr += 1u;
5715       if (ch == '\\' && caddr != eaddr) {
5716         ch = ufoImgGetU8(caddr); caddr += 1u;
5717         switch (ch) {
5718           case 'r': ch = '\r'; break;
5719           case 'n': ch = '\n'; break;
5720           case 't': ch = '\t'; break;
5721           case 'e': ch = '\x1b'; break;
5722           case '`': ch = '"'; break; // special escape to insert double-quote
5723           case '"': ch = '"'; break;
5724           case '\\': ch = '\\'; break;
5725           case 'x': case 'X':
5726             if (eaddr - daddr >= 1) {
5727               const int dg0 = digitInBase((char)(ufoImgGetU8(caddr)), 16);
5728               if (dg0 < 0) ufoFatal("invalid hex string escape");
5729               if (eaddr - daddr >= 2) {
5730                 const int dg1 = digitInBase((char)(ufoImgGetU8(caddr + 1u)), 16);
5731                 if (dg1 < 0) ufoFatal("invalid hex string escape");
5732                 ch = (uint8_t)(dg0 * 16 + dg1);
5733                 caddr += 2u;
5734               } else {
5735                 ch = (uint8_t)dg0;
5736                 caddr += 1u;
5737               }
5738             } else {
5739               ufoFatal("invalid hex string escape");
5740             }
5741             break;
5742           default: ufoFatal("invalid string escape");
5743         }
5744       }
5745       ufoImgPutU8(daddr, ch); daddr += 1u;
5746     }
5747     ufoPush(daddr - addr);
5748   } else {
5749     ufoPush(count);
5750   }
5751 }
5752
5753
5754 // ////////////////////////////////////////////////////////////////////////// //
5755 // numeric conversions
5756 //
5757
5758 // (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
5759 UFWORD(PAR_BASED_NUMBER) {
5760   const uint32_t xbase = ufoPop();
5761   const uint32_t allowSign = ufoPop();
5762   int32_t count = (int32_t)ufoPop();
5763   uint32_t addr = ufoPop();
5764   uint32_t n = 0;
5765   int base = 0;
5766   int neg = 0;
5767   uint8_t ch;
5768
5769   if (allowSign && count > 1) {
5770     ch = ufoImgGetU8(addr);
5771     if (ch == '-') { neg = 1; addr += 1u; count -= 1; }
5772     else if (ch == '+') { neg = 0; addr += 1u; count -= 1; }
5773   }
5774
5775   // special-based numbers
5776   ch = ufoImgGetU8(addr);
5777   if (count >= 3 && ch == '0') {
5778     switch (ufoImgGetU8(addr + 1u)) {
5779       case 'x': case 'X': base = 16; break;
5780       case 'o': case 'O': base = 8; break;
5781       case 'b': case 'B': base = 2; break;
5782       case 'd': case 'D': base = 10; break;
5783       default: break;
5784     }
5785     if (base && digitInBase((char)ufoImgGetU8(addr + (uint32_t)count - 1u), base) >= 0) {
5786       addr += 2; count -= 2;
5787     } else {
5788       base = 0;
5789     }
5790   } else if (count >= 2 && ch == '$') {
5791     base = 16;
5792     addr += 1u; count -= 1;
5793   } else if (count >= 2 && ch == '#') {
5794     base = 16;
5795     addr += 1u; count -= 1;
5796   } else if (count >= 2 && ch == '%') {
5797     base = 2;
5798     addr += 1u; count -= 1;
5799   } else if (count >= 3 && ch == '&') {
5800     switch (ufoImgGetU8(addr + 1u)) {
5801       case 'h': case 'H': base = 16; break;
5802       case 'o': case 'O': base = 8; break;
5803       case 'b': case 'B': base = 2; break;
5804       case 'd': case 'D': base = 10; break;
5805       default: break;
5806     }
5807     if (base) { addr += 2u; count -= 2; }
5808   }
5809   if (!base && count > 2 && ch >= '0' && ch <= '9') {
5810     ch = ufoImgGetU8(addr + (uint32_t)count - 1u);
5811     switch (ch) {
5812       case 'b': case 'B': if (xbase < 12) base = 2; break;
5813       case 'o': case 'O': if (xbase < 25) base = 8; break;
5814       case 'h': case 'H': if (xbase < 18) base = 16; break;
5815     }
5816     if (base) count -= 1;
5817   }
5818
5819   // in current base?
5820   if (!base && xbase < 255) base = xbase;
5821
5822   if (count <= 0 || base < 1 || base > 36) {
5823     ufoPushBool(0);
5824   } else {
5825     uint32_t nc;
5826     int wasDig = 0, wasUnder = 1, error = 0, dig;
5827     while (!error && count != 0) {
5828       ch = ufoImgGetU8(addr); addr += 1u; count -= 1;
5829       if (ch != '_') {
5830         error = 1; wasUnder = 0; wasDig = 1;
5831         dig = digitInBase((char)ch, (int)base);
5832         if (dig >= 0) {
5833           nc = n * (uint32_t)base;
5834           if (nc >= n) {
5835             nc += (uint32_t)dig;
5836             if (nc >= n) {
5837               n = nc;
5838               error = 0;
5839             }
5840           }
5841         }
5842       } else {
5843         error = wasUnder;
5844         wasUnder = 1;
5845       }
5846     }
5847
5848     if (!error && wasDig && !wasUnder) {
5849       if (allowSign && neg) n = ~n + 1u;
5850       ufoPush(n);
5851       ufoPushBool(1);
5852     } else {
5853       ufoPushBool(0);
5854     }
5855   }
5856 }
5857
5858
5859 // ////////////////////////////////////////////////////////////////////////// //
5860 // compiler-related, dictionary-related
5861 //
5862
5863 static char ufoWNameBuf[256];
5864
5865 // (CREATE-WORD-HEADER)
5866 // ( addr count word-flags -- )
5867 UFWORD(PAR_CREATE_WORD_HEADER) {
5868   const uint32_t flags = ufoPop();
5869   const uint32_t wlen = ufoPop();
5870   const uint32_t waddr = ufoPop();
5871   if (wlen == 0) ufoFatal("word name expected");
5872   if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
5873   // copy to separate buffer
5874   for (uint32_t f = 0; f < wlen; f += 1) {
5875     ufoWNameBuf[f] = (char)ufoImgGetU8(waddr + f);
5876   }
5877   ufoWNameBuf[wlen] = 0;
5878   ufoCreateWordHeader(ufoWNameBuf, flags);
5879 }
5880
5881 // (CREATE-NAMELESS-WORD-HEADER)
5882 // ( word-flags -- )
5883 UFWORD(PAR_CREATE_NAMELESS_WORD_HEADER) {
5884   const uint32_t flags = ufoPop();
5885   ufoCreateWordHeader("", flags);
5886 }
5887
5888 // FIND-WORD
5889 // ( addr count -- cfa TRUE / FALSE )
5890 UFWORD(FIND_WORD) {
5891   const uint32_t wlen = ufoPop();
5892   const uint32_t waddr = ufoPop();
5893   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
5894     // copy to separate buffer
5895     for (uint32_t f = 0; f < wlen; f += 1) {
5896       ufoWNameBuf[f] = (char)ufoImgGetU8(waddr + f);
5897     }
5898     ufoWNameBuf[wlen] = 0;
5899     const uint32_t cfa = ufoFindWord(ufoWNameBuf);
5900     if (cfa != 0) {
5901       ufoPush(cfa);
5902       ufoPushBool(1);
5903     } else {
5904       ufoPushBool(0);
5905     }
5906   } else {
5907     ufoPushBool(0);
5908   }
5909 }
5910
5911 // (FIND-WORD-IN-VOC)
5912 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
5913 // find only in the given voc; no name resolution
5914 UFWORD(PAR_FIND_WORD_IN_VOC) {
5915   const uint32_t allowHidden = ufoPop();
5916   const uint32_t vocid = ufoPop();
5917   const uint32_t wlen = ufoPop();
5918   const uint32_t waddr = ufoPop();
5919   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
5920     // copy to separate buffer
5921     for (uint32_t f = 0; f < wlen; f += 1) {
5922       ufoWNameBuf[f] = (char)ufoImgGetU8(waddr + f);
5923     }
5924     ufoWNameBuf[wlen] = 0;
5925     const uint32_t cfa = ufoFindWordInVoc(ufoWNameBuf, wlen, 0, vocid, (allowHidden ? 1 : 0));
5926     if (cfa != 0) {
5927       ufoPush(cfa);
5928       ufoPushBool(1);
5929     } else {
5930       ufoPushBool(0);
5931     }
5932   } else {
5933     ufoPushBool(0);
5934   }
5935 }
5936
5937 // (FIND-WORD-IN-VOC-AND-PARENTS)
5938 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
5939 // find only in the given voc; no name resolution
5940 UFWORD(PAR_FIND_WORD_IN_VOC_AND_PARENTS) {
5941   const uint32_t allowHidden = ufoPop();
5942   const uint32_t vocid = ufoPop();
5943   const uint32_t wlen = ufoPop();
5944   const uint32_t waddr = ufoPop();
5945   if (wlen > 0 && wlen < UFO_MAX_WORD_LENGTH) {
5946     // copy to separate buffer
5947     for (uint32_t f = 0; f < wlen; f += 1) {
5948       ufoWNameBuf[f] = (char)ufoImgGetU8(waddr + f);
5949     }
5950     ufoWNameBuf[wlen] = 0;
5951     const uint32_t cfa = ufoFindWordInVocAndParents(ufoWNameBuf, wlen, 0, vocid, (allowHidden ? 1 : 0));
5952     if (cfa != 0) {
5953       ufoPush(cfa);
5954       ufoPushBool(1);
5955     } else {
5956       ufoPushBool(0);
5957     }
5958   } else {
5959     ufoPushBool(0);
5960   }
5961 }
5962
5963 // FIND-WORD-IN-VOC
5964 // ( addr count vocid -- cfa TRUE / FALSE)
5965 // find only in the given voc; no name resolution, no hidden words
5966 UFWORD(FIND_WORD_IN_VOC) { ufoPush(0); UFCALL(PAR_FIND_WORD_IN_VOC); }
5967
5968 // FIND-WORD-IN-VOC-AND-PARENTS
5969 // ( addr count vocid -- cfa TRUE / FALSE)
5970 // find only in the given voc; no name resolution, no hidden words
5971 UFWORD(FIND_WORD_IN_VOC_AND_PARENTS) { ufoPush(0); UFCALL(PAR_FIND_WORD_IN_VOC_AND_PARENTS); }
5972
5973
5974 // ////////////////////////////////////////////////////////////////////////// //
5975 // more compiler words
5976 //
5977
5978 // ////////////////////////////////////////////////////////////////////////// //
5979 // vocabulary and wordlist utilities
5980 //
5981
5982 // (VSP@)
5983 // ( -- vsp )
5984 UFWORD(PAR_GET_VSP) {
5985   ufoPush(ufoVSP);
5986 }
5987
5988 // (VSP!)
5989 // ( vsp -- )
5990 UFWORD(PAR_SET_VSP) {
5991   const uint32_t vsp = ufoPop();
5992   if (vsp > UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
5993   ufoVSP = vsp;
5994 }
5995
5996 // (VSP-AT@)
5997 // ( idx -- value )
5998 UFWORD(PAR_VSP_LOAD) {
5999   const uint32_t vsp = ufoPop();
6000   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
6001   ufoPush(ufoVocStack[vsp]);
6002 }
6003
6004 // (VSP-AT!)
6005 // ( value idx -- )
6006 UFWORD(PAR_VSP_STORE) {
6007   const uint32_t vsp = ufoPop();
6008   const uint32_t value = ufoPop();
6009   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
6010   ufoVocStack[vsp] = value;
6011 }
6012
6013
6014 // ////////////////////////////////////////////////////////////////////////// //
6015 // word field address conversion
6016 //
6017
6018 // CFA->DOES-CFA
6019 // ( cfa -- does-cfa )
6020 UFWORD(CFA2DOESCFA) {
6021   UFO_STACK(1);
6022   UFO_TOS = UFO_CFA_TO_DOES_CFA(UFO_TOS);
6023 }
6024
6025 // CFA->PFA
6026 // ( cfa -- pfa )
6027 UFWORD(CFA2PFA) {
6028   UFO_STACK(1);
6029   UFO_TOS = UFO_CFA_TO_PFA(UFO_TOS);
6030 }
6031
6032 // CFA->NFA
6033 // ( cfa -- nfa )
6034 UFWORD(CFA2NFA) {
6035   UFO_STACK(1);
6036   UFO_TOS = UFO_CFA_TO_NFA(UFO_TOS);
6037 }
6038
6039 // CFA->LFA
6040 // ( cfa -- lfa )
6041 UFWORD(CFA2LFA) {
6042   UFO_STACK(1);
6043   UFO_TOS = UFO_CFA_TO_LFA(UFO_TOS);
6044 }
6045
6046 // CFA->WEND
6047 // ( cfa -- wend-addr )
6048 UFWORD(CFA2WEND) {
6049   UFO_STACK(1);
6050   UFO_TOS = ufoGetWordEndAddr(UFO_TOS);
6051 }
6052
6053 // PFA->CFA
6054 // ( pfa -- cfa )
6055 UFWORD(PFA2CFA) {
6056   UFO_STACK(1);
6057   UFO_TOS = UFO_PFA_TO_CFA(UFO_TOS);
6058 }
6059
6060 // PFA->NFA
6061 // ( pfa -- nfa )
6062 UFWORD(PFA2NFA) {
6063   UFO_STACK(1);
6064   UFO_TOS = UFO_PFA_TO_CFA(UFO_TOS);
6065   UFO_TOS = UFO_CFA_TO_NFA(UFO_TOS);
6066 }
6067
6068 // NFA->CFA
6069 // ( nfa -- cfa )
6070 UFWORD(NFA2CFA) {
6071   UFO_STACK(1);
6072   UFO_TOS = UFO_NFA_TO_CFA(UFO_TOS);
6073 }
6074
6075 // NFA->PFA
6076 // ( nfa -- pfa )
6077 UFWORD(NFA2PFA) {
6078   UFO_STACK(1);
6079   UFO_TOS = UFO_NFA_TO_CFA(UFO_TOS);
6080   UFO_TOS = UFO_CFA_TO_PFA(UFO_TOS);
6081 }
6082
6083 // NFA->LFA
6084 // ( nfa -- lfa )
6085 UFWORD(NFA2LFA) {
6086   UFO_STACK(1);
6087   UFO_TOS = UFO_NFA_TO_LFA(UFO_TOS);
6088 }
6089
6090 // LFA->CFA
6091 // ( lfa -- cfa )
6092 UFWORD(LFA2CFA) {
6093   UFO_STACK(1);
6094   UFO_TOS = UFO_LFA_TO_CFA(UFO_TOS);
6095 }
6096
6097 // LFA->PFA
6098 // ( lfa -- pfa )
6099 UFWORD(LFA2PFA) {
6100   UFO_STACK(1);
6101   UFO_TOS = UFO_LFA_TO_CFA(UFO_TOS);
6102   UFO_TOS = UFO_CFA_TO_PFA(UFO_TOS);
6103 }
6104
6105 // LFA->BFA
6106 // ( lfa -- bfa )
6107 UFWORD(LFA2BFA) {
6108   UFO_STACK(1);
6109   UFO_TOS = UFO_LFA_TO_BFA(UFO_TOS);
6110 }
6111
6112 // LFA->XFA
6113 // ( lfa -- xfa )
6114 UFWORD(LFA2XFA) {
6115   UFO_STACK(1);
6116   UFO_TOS = UFO_LFA_TO_XFA(UFO_TOS);
6117 }
6118
6119 // LFA->YFA
6120 // ( lfa -- yfa )
6121 UFWORD(LFA2YFA) {
6122   UFO_STACK(1);
6123   UFO_TOS = UFO_LFA_TO_YFA(UFO_TOS);
6124 }
6125
6126 // LFA->NFA
6127 // ( lfa -- nfa )
6128 UFWORD(LFA2NFA) {
6129   UFO_STACK(1);
6130   UFO_TOS = UFO_LFA_TO_NFA(UFO_TOS);
6131 }
6132
6133 // IP->NFA
6134 // ( ip -- nfa / 0 )
6135 UFWORD(IP2NFA) {
6136   UFO_STACK(1);
6137   UFO_TOS = ufoFindWordForIP(UFO_TOS);
6138 }
6139
6140 // IP->FILE/LINE
6141 // ( ip -- addr count line TRUE / FALSE )
6142 // name is at PAD; it is safe to use PAD, because each task has its own temp image
6143 UFWORD(IP2FILELINE) {
6144   const uint32_t ip = ufoPop();
6145   uint32_t fline;
6146   const char *fname = ufoFindFileForIP(ip, &fline, NULL, NULL);
6147   if (fname != NULL) {
6148     uint32_t addr = UFO_PAD_ADDR;
6149     uint32_t count = 0;
6150     while (*fname != 0) {
6151       ufoImgPutU8(addr, *(const unsigned char *)fname);
6152       fname += 1u; addr += 1u; count += 1u;
6153     }
6154     ufoImgPutU8(addr, 0); // just in case
6155     ufoPush(count);
6156     ufoPush(fline);
6157     ufoPushBool(1);
6158   } else {
6159     ufoPushBool(0);
6160   }
6161 }
6162
6163
6164 // IP->FILE-HASH/LINE
6165 // ( ip -- len hash line TRUE / FALSE )
6166 UFWORD(IP2FILEHASHLINE) {
6167   const uint32_t ip = ufoPop();
6168   uint32_t fline, fhash, flen;
6169   const char *fname = ufoFindFileForIP(ip, &fline, &flen, &fhash);
6170   if (fname != NULL) {
6171     ufoPush(flen);
6172     ufoPush(fhash);
6173     ufoPush(fline);
6174     ufoPushBool(1);
6175   } else {
6176     ufoPushBool(0);
6177   }
6178 }
6179
6180
6181 // ////////////////////////////////////////////////////////////////////////// //
6182 // string operations
6183 //
6184
6185 UFO_FORCE_INLINE uint32_t ufoHashBuf (uint32_t addr, uint32_t size, uint8_t orbyte) {
6186   uint32_t hash = 0x29a;
6187   if ((size & ((uint32_t)1<<31)) == 0) {
6188     while (size != 0) {
6189       hash += ufoImgGetU8(addr) | orbyte;
6190       hash += hash<<10;
6191       hash ^= hash>>6;
6192       addr += 1u; size -= 1u;
6193     }
6194   }
6195   // finalize
6196   hash += hash<<3;
6197   hash ^= hash>>11;
6198   hash += hash<<15;
6199   return hash;
6200 }
6201
6202 //==========================================================================
6203 //
6204 //  ufoBufEqu
6205 //
6206 //==========================================================================
6207 UFO_FORCE_INLINE int ufoBufEqu (uint32_t addr0, uint32_t addr1, uint32_t count) {
6208   int res;
6209   if ((count & ((uint32_t)1<<31)) == 0) {
6210     res = 1;
6211     while (res != 0 && count != 0) {
6212       res = (toUpperU8(ufoImgGetU8(addr0)) == toUpperU8(ufoImgGetU8(addr1)));
6213       addr0 += 1u; addr1 += 1u; count -= 1u;
6214     }
6215   } else {
6216     res = 0;
6217   }
6218   return res;
6219 }
6220
6221 // STRING:=
6222 // ( a0 c0 a1 c1 -- bool )
6223 UFWORD(STREQU) {
6224   int32_t c1 = (int32_t)ufoPop();
6225   uint32_t a1 = ufoPop();
6226   int32_t c0 = (int32_t)ufoPop();
6227   uint32_t a0 = ufoPop();
6228   if (c0 < 0) c0 = 0;
6229   if (c1 < 0) c1 = 0;
6230   if (c0 == c1) {
6231     int res = 1;
6232     while (res != 0 && c0 != 0) {
6233       res = (ufoImgGetU8(a0) == ufoImgGetU8(a1));
6234       a0 += 1; a1 += 1; c0 -= 1;
6235     }
6236     ufoPushBool(res);
6237   } else {
6238     ufoPushBool(0);
6239   }
6240 }
6241
6242 // STRING:=CI
6243 // ( a0 c0 a1 c1 -- bool )
6244 UFWORD(STREQUCI) {
6245   int32_t c1 = (int32_t)ufoPop();
6246   uint32_t a1 = ufoPop();
6247   int32_t c0 = (int32_t)ufoPop();
6248   uint32_t a0 = ufoPop();
6249   if (c0 < 0) c0 = 0;
6250   if (c1 < 0) c1 = 0;
6251   if (c0 == c1) {
6252     int res = 1;
6253     while (res != 0 && c0 != 0) {
6254       res = (toUpperU8(ufoImgGetU8(a0)) == toUpperU8(ufoImgGetU8(a1)));
6255       a0 += 1; a1 += 1; c0 -= 1;
6256     }
6257     ufoPushBool(res);
6258   } else {
6259     ufoPushBool(0);
6260   }
6261 }
6262
6263 // search the string specified by c-addr1 u1 for the string specified by c-addr2 u2.
6264 // if flag is true, a match was found at c-addr3 with u3 characters remaining.
6265 // if flag is false there was no match and c-addr3 is c-addr1 and u3 is u1.
6266 // ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag )
6267 UFWORD(SEARCH) {
6268   const uint32_t pcount = ufoPop();
6269   const uint32_t paddr = ufoPop();
6270   const uint32_t tcount = ufoPop();
6271   const uint32_t taddr = ufoPop();
6272   if ((pcount & ((uint32_t)1 << 31)) == 0 && (tcount & ((uint32_t)1 << 31)) == 0) {
6273     for (uint32_t f = 0; tcount - f >= pcount; f += 1) {
6274       if (ufoBufEqu(taddr + f, paddr, pcount)) {
6275         ufoPush(taddr + f);
6276         ufoPush(tcount - f);
6277         ufoPushBool(1);
6278         return;
6279       }
6280     }
6281   }
6282   ufoPush(taddr);
6283   ufoPush(tcount);
6284   ufoPushBool(0);
6285 }
6286
6287 // STRING:HASH
6288 // ( addr count -- hash )
6289 UFWORD(STRHASH) {
6290   uint32_t count = ufoPop();
6291   uint32_t addr = ufoPop();
6292   ufoPush(ufoHashBuf(addr, count, 0));
6293 }
6294
6295 // STRING:HASH-CI
6296 // ( addr count -- hash )
6297 UFWORD(STRHASHCI) {
6298   uint32_t count = ufoPop();
6299   uint32_t addr = ufoPop();
6300   ufoPush(ufoHashBuf(addr, count, 0x20));
6301 }
6302
6303 // STRING:CHAR-UPPER
6304 // ( ch -- ch )
6305 UFWORD(CHAR_UPPER) {
6306   UFO_STACK(1);
6307   uint32_t c = UFO_TOS & 0xffU;
6308   if (c >= 'a' && c <= 'z') c = c - 'a' + 'A';
6309   UFO_TOS = c;
6310 }
6311
6312 // STRING:CHAR-LOWER
6313 // ( ch -- ch )
6314 UFWORD(CHAR_LOWER) {
6315   UFO_STACK(1);
6316   uint32_t c = UFO_TOS & 0xffU;
6317   if (c >= 'A' && c <= 'Z') c = c - 'A' + 'a';
6318   UFO_TOS = c;
6319 }
6320
6321 // STRING:UPPER
6322 // ( addr count -- )
6323 UFWORD(STRUPPER) {
6324   int32_t count = (int32_t)ufoPop();
6325   uint32_t addr = ufoPop();
6326   while (count > 0) {
6327     uint32_t c = ufoImgGetU8(addr);
6328     if (c >= 'a' && c <= 'z') {
6329       c = c - 'a' + 'A';
6330       ufoImgPutU8(addr, c);
6331     }
6332     addr += 1u; count -= 1;
6333   }
6334 }
6335
6336 // STRING:LOWER
6337 // ( addr count -- )
6338 UFWORD(STRLOWER) {
6339   int32_t count = (int32_t)ufoPop();
6340   uint32_t addr = ufoPop();
6341   while (count > 0) {
6342     uint32_t c = ufoImgGetU8(addr);
6343     if (c >= 'A' && c <= 'Z') {
6344       c = c - 'A' + 'a';
6345       ufoImgPutU8(addr, c);
6346     }
6347     addr += 1u; count -= 1;
6348   }
6349 }
6350
6351 // STRING:(CHAR-DIGIT)
6352 // ( ch -- digit true // false )
6353 UFWORD(CHAR_DIGIT) {
6354   UFO_STACK(1);
6355   const uint32_t c = UFO_TOS;
6356   if (c >= '0' && c <= '9') { UFO_TOS = c - '0'; ufoPushBool(1); }
6357   else if (c >= 'A' && c <= 'Z') { UFO_TOS = c - 'A' + 10; ufoPushBool(1); }
6358   else if (c >= 'a' && c <= 'z') { UFO_TOS = c - 'a' + 10; ufoPushBool(1); }
6359   else UFO_TOS = 0;
6360 }
6361
6362 // STRING:DIGIT
6363 // ( char base -- digit TRUE / FALSE )
6364 UFWORD(DIGIT) {
6365   const uint32_t base = ufoPop();
6366   UFO_STACK(1);
6367   if (base > 0 && base < 0x80000000u) {
6368     uint32_t c = UFO_TOS;
6369     if (c >= '0' && c <= '9') c = c - '0';
6370     else if (c >= 'A' && c <= 'Z') c = c - 'A' + 10;
6371     else if (c >= 'a' && c <= 'z') c = c - 'a' + 10;
6372     else { UFO_TOS = 0; return; }
6373     if (c < base) { UFO_TOS = c; ufoPushBool(1); } else UFO_TOS = 0;
6374   } else {
6375     UFO_TOS = 0;
6376   }
6377 }
6378
6379 // STRING:DIGIT?
6380 // ( char base -- TRUE / FALSE )
6381 UFWORD(DIGITQ) {
6382   const uint32_t base = ufoPop();
6383   UFO_STACK(1);
6384   if (base > 0 && base < 0x80000000u) {
6385     uint32_t c = UFO_TOS;
6386     if (c >= '0' && c <= '9') c = c - '0';
6387     else if (c >= 'A' && c <= 'Z') c = c - 'A' + 10;
6388     else if (c >= 'a' && c <= 'z') c = c - 'a' + 10;
6389     else { UFO_TOS = 0; return; }
6390     if (c < base) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6391   } else {
6392     UFO_TOS = 0;
6393   }
6394 }
6395
6396
6397 // MEMCMP
6398 // ( addr1 addr2 size -- -1|0|1 )
6399 UFWORD(MEMCMP) {
6400   uint32_t count = ufoPop();
6401   uint32_t addr1 = ufoPop();
6402   uint32_t addr0 = ufoPop();
6403   if ((count & 0x80000000u) == 0) {
6404     while (count != 0) {
6405       const int n = (int)ufoImgGetU8(addr0) - (int)ufoImgGetU8(addr1);
6406       if (n != 0) {
6407         if (n < 0) ufoPush(~(uint32_t)0); else ufoPush(1);
6408         return;
6409       }
6410       addr0 += 1u; addr1 += 1u; count -= 1u;
6411     }
6412     ufoPush(0);
6413   } else {
6414     ufoFatal("invalid MEMCMP counter");
6415   }
6416 }
6417
6418 // MEMCMP-CI
6419 // ( addr1 addr2 size -- -1|0|1 )
6420 UFWORD(MEMCMP_CI) {
6421   uint32_t count = ufoPop();
6422   uint32_t addr1 = ufoPop();
6423   uint32_t addr0 = ufoPop();
6424   if ((count & 0x80000000u) == 0) {
6425     while (count != 0) {
6426       const int c0 = (int)toUpperU8(ufoImgGetU8(addr0));
6427       const int c1 = (int)toUpperU8(ufoImgGetU8(addr1));
6428       const int n = c0 - c1;
6429       if (n != 0) {
6430         if (n < 0) ufoPush(~(uint32_t)0); else ufoPush(1);
6431         return;
6432       }
6433       addr0 += 1u; addr1 += 1u; count -= 1u;
6434     }
6435     ufoPush(0);
6436   } else {
6437     ufoFatal("invalid MEMCMP counter");
6438   }
6439 }
6440
6441 // FILL-CELLS
6442 // ( addr count u32 -- )
6443 UFWORD(FILL_CELLS) {
6444   const uint32_t v = ufoPop();
6445   uint32_t count = ufoPop();
6446   uint32_t dest = ufoPop();
6447   if ((count & 0x80000000u) == 0) {
6448     while (count != 0) {
6449       ufoImgPutU32(dest, v);
6450       dest += 4u; count -= 1u;
6451     }
6452   }
6453 }
6454
6455 // FILL
6456 // ( addr count byte -- )
6457 UFWORD(FILL) {
6458   const uint32_t v = ufoPop() & 0xffU;
6459   uint32_t count = ufoPop();
6460   uint32_t dest = ufoPop();
6461   if (count != 0 && (count & 0x80000000u) == 0) {
6462     while (count != 0 && (dest & 3) != 0) {
6463       ufoImgPutU8(dest, v);
6464       dest += 1u; count -= 1u;
6465     }
6466     if (count >= 4u) {
6467       const uint32_t vv = (v << 24) | (v << 16) | (v << 8) | v;
6468       while (count >= 4u) {
6469         ufoImgPutU32(dest, vv);
6470         dest += 4u; count -= 4u;
6471       }
6472     }
6473     while (count != 0) {
6474       ufoImgPutU8(dest, v);
6475       dest += 1u; count -= 1u;
6476     }
6477   }
6478 }
6479
6480 //==========================================================================
6481 //
6482 //  doCMoveFwd
6483 //
6484 //==========================================================================
6485 static void doCMoveFwd (uint32_t src, uint32_t dest, uint32_t count) {
6486   uint32_t v;
6487   if (count != 0 && (count & 0x80000000u) == 0 && src != dest) {
6488     if ((src & 3) == (dest & 3)) {
6489       // we can align addresses
6490       while (count != 0 && (src & 3) != 0) {
6491         v = ufoImgGetU8(src); ufoImgPutU8(dest, v);
6492         src += 1u; dest += 1u; count -= 1u;
6493       }
6494       // ...and move by whole cells
6495       while (count >= 4u) {
6496         v = ufoImgGetU32(src); ufoImgPutU32(dest, v);
6497         src += 4u; dest += 4u; count -= 4u;
6498       }
6499     }
6500     // do the rest
6501     while (count != 0) {
6502       v = ufoImgGetU8(src); ufoImgPutU8(dest, v);
6503       src += 1u; dest += 1u; count -= 1u;
6504     }
6505   }
6506 }
6507
6508 //==========================================================================
6509 //
6510 //  doCMoveBwd
6511 //
6512 //==========================================================================
6513 static void doCMoveBwd (uint32_t src, uint32_t dest, uint32_t count) {
6514   if (count != 0 && (count & 0x80000000u) == 0 && src != dest) {
6515     src += count; dest += count;
6516     while (count != 0) {
6517       src -= 1u; dest -= 1u; count -= 1u;
6518       const uint8_t v = ufoImgGetU8(src); ufoImgPutU8(dest, v);
6519     }
6520   }
6521 }
6522
6523 // CMOVE-CELLS
6524 // ( source dest count -- )
6525 UFWORD(CMOVE_CELLS_FWD) {
6526   uint32_t count = ufoPop();
6527   uint32_t dest = ufoPop();
6528   uint32_t src = ufoPop();
6529   if (count != 0 && (count & 0x80000000u) == 0 && src != dest) {
6530     if (count * 4u >= 0x80000000u) ufoFatal("invalid CMOVE-CELLS counter");
6531     doCMoveFwd(src, dest, count * 4u);
6532   }
6533 }
6534
6535 // CMOVE>-CELLS
6536 // ( source dest count -- )
6537 UFWORD(CMOVE_CELLS_BWD) {
6538   uint32_t count = ufoPop();
6539   uint32_t dest = ufoPop();
6540   uint32_t src = ufoPop();
6541   if ((count & 0x80000000u) == 0) {
6542     src += count * 4u; dest += count * 4u;
6543     while (count != 0) {
6544       src -= 4u; dest -= 4u; count -= 1u;
6545       const uint32_t v = ufoImgGetU32(src); ufoImgPutU32(dest, v);
6546     }
6547   }
6548 }
6549
6550 // CMOVE
6551 // ( source dest count -- )
6552 UFWORD(CMOVE_FWD) {
6553   uint32_t count = ufoPop();
6554   uint32_t dest = ufoPop();
6555   uint32_t src = ufoPop();
6556   doCMoveFwd(src, dest, count);
6557 }
6558
6559 // CMOVE>
6560 // ( source dest count -- )
6561 UFWORD(CMOVE_BWD) {
6562   uint32_t count = ufoPop();
6563   uint32_t dest = ufoPop();
6564   uint32_t src = ufoPop();
6565   doCMoveBwd(src, dest, count);
6566 }
6567
6568 // MOVE
6569 // ( source dest count -- )
6570 UFWORD(MOVE) {
6571   uint32_t count = ufoPop();
6572   uint32_t dest = ufoPop();
6573   uint32_t src = ufoPop();
6574   if (count != 0 && (count & 0x80000000u) == 0 && src != dest) {
6575     if (src + count <= src || dest + count <= dest) ufoFatal("invalid MOVE");
6576     if (src <= dest && src + count > dest) doCMoveBwd(src, dest, count);
6577     else doCMoveFwd(src, dest, count);
6578   }
6579 }
6580
6581
6582 // ////////////////////////////////////////////////////////////////////////// //
6583 // heavily used in UrAsm
6584 //
6585
6586 // IS-DIGIT
6587 // ( ch -- bool )
6588 UFWORD(IS_DIGIT) {
6589   UFO_STACK(1);
6590   const uint32_t c = UFO_TOS & 0xffU;
6591   if (c >= '0' && c <= '9') UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6592 }
6593
6594 // IS-BIN-DIGIT
6595 // ( ch -- bool )
6596 UFWORD(IS_BIN_DIGIT) {
6597   UFO_STACK(1);
6598   const uint32_t c = UFO_TOS & 0xffU;
6599   if (c >= '0' && c <= '1') UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6600 }
6601
6602 // IS-OCT-DIGIT
6603 // ( ch -- bool )
6604 UFWORD(IS_OCT_DIGIT) {
6605   UFO_STACK(1);
6606   const uint32_t c = UFO_TOS & 0xffU;
6607   if (c >= '0' && c <= '7') UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6608 }
6609
6610 // IS-HEX-DIGIT
6611 // ( ch -- bool )
6612 UFWORD(IS_HEX_DIGIT) {
6613   UFO_STACK(1);
6614   const uint32_t c = UFO_TOS & 0xffU;
6615   if ((c >= '0' && c <= '9') ||
6616       (c >= 'A' && c <= 'F') ||
6617       (c >= 'a' && c <= 'f')) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6618 }
6619
6620 // IS-ALPHA
6621 // ( ch -- bool )
6622 UFWORD(IS_ALPHA) {
6623   UFO_STACK(1);
6624   const uint32_t c = UFO_TOS & 0xffU;
6625   if ((c >= 'A' && c <= 'Z') ||
6626       (c >= 'a' && c <= 'z')) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6627 }
6628
6629 // IS-UNDER-DOT
6630 // ( ch -- bool )
6631 UFWORD(IS_UNDER_DOT) {
6632   UFO_STACK(1);
6633   const uint32_t c = UFO_TOS & 0xffU;
6634   if (c == '_' || c == '.') UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6635 }
6636
6637 // IS-ALNUM
6638 // ( ch -- bool )
6639 UFWORD(IS_ALNUM) {
6640   UFO_STACK(1);
6641   const uint32_t c = UFO_TOS & 0xffU;
6642   if ((c >= 'A' && c <= 'Z') ||
6643       (c >= 'a' && c <= 'z') ||
6644       (c >= '0' && c <= '9')) UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6645 }
6646
6647 // IS-ID-START
6648 // ( ch -- bool )
6649 UFWORD(IS_ID_START) {
6650   UFO_STACK(1);
6651   const uint32_t c = UFO_TOS & 0xffU;
6652   if ((c >= 'A' && c <= 'Z') ||
6653       (c >= 'a' && c <= 'z') ||
6654       c == '_' || c == '.') UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6655 }
6656
6657 // IS-ID-CHAR
6658 // ( ch -- bool )
6659 UFWORD(IS_ID_CHAR) {
6660   UFO_STACK(1);
6661   const uint32_t c = UFO_TOS & 0xffU;
6662   if ((c >= 'A' && c <= 'Z') ||
6663       (c >= 'a' && c <= 'z') ||
6664       (c >= '0' && c <= '9') ||
6665       c == '_' || c == '.') UFO_TOS = ufoTrueValue; else UFO_TOS = 0;
6666 }
6667
6668
6669 // ////////////////////////////////////////////////////////////////////////// //
6670 // conditional defines
6671 //
6672
6673 typedef struct UForthCondDefine_t UForthCondDefine;
6674 struct UForthCondDefine_t {
6675   char *name;
6676   uint32_t namelen;
6677   uint32_t hash;
6678   UForthCondDefine *next;
6679 };
6680
6681 static UForthCondDefine *ufoCondDefines = NULL;
6682 static char ufoErrMsgBuf[4096];
6683
6684
6685 //==========================================================================
6686 //
6687 //  ufoStrEquCI
6688 //
6689 //==========================================================================
6690 UFO_DISABLE_INLINE int ufoStrEquCI (const void *str0, const void *str1) {
6691   const unsigned char *s0 = (const unsigned char *)str0;
6692   const unsigned char *s1 = (const unsigned char *)str1;
6693   while (*s0 && *s1) {
6694     if (toUpperU8(*s0) != toUpperU8(*s1)) return 0;
6695     s0 += 1; s1 += 1;
6696   }
6697   return (*s0 == 0 && *s1 == 0);
6698 }
6699
6700
6701 //==========================================================================
6702 //
6703 //  ufoBufEquCI
6704 //
6705 //==========================================================================
6706 UFO_FORCE_INLINE int ufoBufEquCI (uint32_t addr, uint32_t count, const void *buf) {
6707   int res;
6708   if ((count & ((uint32_t)1<<31)) == 0) {
6709     const unsigned char *src = (const unsigned char *)buf;
6710     res = 1;
6711     while (res != 0 && count != 0) {
6712       res = (toUpperU8(*src) == toUpperU8(ufoImgGetU8(addr)));
6713       src += 1; addr += 1u; count -= 1u;
6714     }
6715   } else {
6716     res = 0;
6717   }
6718   return res;
6719 }
6720
6721
6722 //==========================================================================
6723 //
6724 //  ufoClearCondDefines
6725 //
6726 //==========================================================================
6727 static void ufoClearCondDefines (void) {
6728   while (ufoCondDefines) {
6729     UForthCondDefine *df = ufoCondDefines;
6730     ufoCondDefines = df->next;
6731     if (df->name) free(df->name);
6732     free(df);
6733   }
6734 }
6735
6736
6737 //==========================================================================
6738 //
6739 //  ufoHasCondDefine
6740 //
6741 //==========================================================================
6742 int ufoHasCondDefine (const char *name) {
6743   int res = 0;
6744   if (name != NULL && name[0] != 0) {
6745     const size_t nlen = strlen(name);
6746     if (nlen <= 255) {
6747       const uint32_t hash = joaatHashBufCI(name, nlen);
6748       UForthCondDefine *dd = ufoCondDefines;
6749       while (res == 0 && dd != NULL) {
6750         if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
6751           res = ufoStrEquCI(name, dd->name);
6752         }
6753         dd = dd->next;
6754       }
6755     }
6756   }
6757   return res;
6758 }
6759
6760
6761 //==========================================================================
6762 //
6763 //  ufoCondDefine
6764 //
6765 //==========================================================================
6766 void ufoCondDefine (const char *name) {
6767   if (name != NULL && name[0] != 0) {
6768     const size_t nlen = strlen(name);
6769     if (nlen > 255) ufoFatal("conditional define name too long");
6770     const uint32_t hash = joaatHashBufCI(name, nlen);
6771     UForthCondDefine *dd = ufoCondDefines;
6772     int res = 0;
6773     while (res == 0 && dd != NULL) {
6774       if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
6775         res = ufoStrEquCI(name, dd->name);
6776       }
6777       dd = dd->next;
6778     }
6779     if (res == 0) {
6780       // new define
6781       dd = calloc(1, sizeof(UForthCondDefine));
6782       if (dd == NULL) ufoFatal("out of memory for defines");
6783       dd->name = strdup(name);
6784       if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
6785       dd->namelen = (uint32_t)nlen;
6786       dd->hash = hash;
6787       dd->next = ufoCondDefines;
6788       ufoCondDefines = dd;
6789     }
6790   }
6791 }
6792
6793
6794 //==========================================================================
6795 //
6796 //  ufoCondUndef
6797 //
6798 //==========================================================================
6799 void ufoCondUndef (const char *name) {
6800   if (name != NULL && name[0] != 0) {
6801     const size_t nlen = strlen(name);
6802     if (nlen <= 255) {
6803       const uint32_t hash = joaatHashBufCI(name, nlen);
6804       UForthCondDefine *dd = ufoCondDefines;
6805       UForthCondDefine *prev = NULL;
6806       while (dd != NULL) {
6807         if (dd->hash == hash && dd->namelen == (uint32_t)nlen) {
6808           if (ufoStrEquCI(name, dd->name)) {
6809             if (prev != NULL) prev->next = dd->next; else ufoCondDefines = dd->next;
6810             free(dd->name);
6811             free(dd);
6812             dd = NULL;
6813           }
6814         }
6815         if (dd != NULL) { prev = dd; dd = dd->next; }
6816       }
6817     }
6818   }
6819 }
6820
6821
6822 // ($DEFINE)
6823 // ( addr count -- )
6824 UFWORD(PAR_DLR_DEFINE) {
6825   uint32_t count = ufoPop();
6826   uint32_t addr = ufoPop();
6827   if (count == 0) ufoFatal("empty define");
6828   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
6829   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
6830   UForthCondDefine *dd;
6831   for (dd = ufoCondDefines; dd != NULL; dd = dd->next) {
6832     if (dd->hash == hash && dd->namelen == count) {
6833       if (ufoBufEquCI(addr, count, dd->name)) return;
6834     }
6835   }
6836   // new define
6837   dd = calloc(1, sizeof(UForthCondDefine));
6838   if (dd == NULL) ufoFatal("out of memory for defines");
6839   dd->name = calloc(1, count + 1u);
6840   if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
6841   for (uint32_t f = 0; f < count; f += 1) {
6842     ((unsigned char *)dd->name)[f] = ufoImgGetU8(addr + f);
6843   }
6844   dd->namelen = count;
6845   dd->hash = hash;
6846   dd->next = ufoCondDefines;
6847   ufoCondDefines = dd;
6848 }
6849
6850 // ($UNDEF)
6851 // ( addr count -- )
6852 UFWORD(PAR_DLR_UNDEF) {
6853   uint32_t count = ufoPop();
6854   uint32_t addr = ufoPop();
6855   if (count == 0) ufoFatal("empty define");
6856   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
6857   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
6858   UForthCondDefine *prev = NULL;
6859   UForthCondDefine *dd;
6860   for (dd = ufoCondDefines; dd != NULL; prev = dd, dd = dd->next) {
6861     if (dd->hash == hash && dd->namelen == count) {
6862       if (ufoBufEquCI(addr, count, dd->name)) {
6863         if (prev == NULL) ufoCondDefines = dd->next; else prev->next = dd->next;
6864         free(dd->name);
6865         free(dd);
6866         return;
6867       }
6868     }
6869   }
6870 }
6871
6872 // ($DEFINED?)
6873 // ( addr count -- bool )
6874 UFWORD(PAR_DLR_DEFINEDQ) {
6875   uint32_t count = ufoPop();
6876   uint32_t addr = ufoPop();
6877   if (count == 0) ufoFatal("empty define");
6878   if (count >= UFO_MAX_WORD_LENGTH) ufoFatal("define too long");
6879   const uint32_t hash = ufoHashBuf(addr, count, 0x20);
6880   int found = 0;
6881   UForthCondDefine *dd = ufoCondDefines;
6882   while (!found && dd != NULL) {
6883     if (dd->hash == hash && dd->namelen == count) {
6884       found = ufoBufEquCI(addr, count, dd->name);
6885     }
6886     dd = dd->next;
6887   }
6888   ufoPushBool(found);
6889 }
6890
6891
6892 // ////////////////////////////////////////////////////////////////////////// //
6893 // error reporting
6894 //
6895
6896 // ERROR
6897 // ( addr count -- )
6898 UFWORD(ERROR) {
6899   uint32_t count = ufoPop();
6900   uint32_t addr = ufoPop();
6901   if (count & (1u<<31)) ufoFatal("invalid error message");
6902   if (count == 0) ufoFatal("some error");
6903   if (count > (uint32_t)sizeof(ufoErrMsgBuf) - 1u) count = (uint32_t)sizeof(ufoErrMsgBuf) - 1u;
6904   for (uint32_t f = 0; f < count; f += 1) {
6905     ufoErrMsgBuf[f] = (char)ufoImgGetU8(addr + f);
6906   }
6907   ufoErrMsgBuf[count] = 0;
6908   ufoFatal("%s", ufoErrMsgBuf);
6909 }
6910
6911 // (USER-ABORT)
6912 UFWORD(PAR_USER_ABORT) {
6913   ufoFatal("user abort");
6914 }
6915
6916 // ?ERROR
6917 // ( errflag addr count -- )
6918 UFWORD(QERROR) {
6919   UFO_STACK(3);
6920   if (UFO_S(2)) {
6921     UFCALL(ERROR);
6922   } else {
6923     ufoSP -= 3u;
6924   }
6925 }
6926
6927 // ?NOT-ERROR
6928 // ( errflag addr count -- )
6929 UFWORD(QNOTERROR) {
6930   UFO_STACK(3);
6931   if (UFO_S(2) == 0) {
6932     UFCALL(ERROR);
6933   } else {
6934     ufoSP -= 3u;
6935   }
6936 }
6937
6938
6939 // ////////////////////////////////////////////////////////////////////////// //
6940 // includes
6941 //
6942
6943 static char ufoFNameBuf[4096];
6944
6945
6946 //==========================================================================
6947 //
6948 //  ufoScanIncludeFileName
6949 //
6950 //  `*psys` and `*psoft` must be initialised!
6951 //
6952 //==========================================================================
6953 static void ufoScanIncludeFileName (uint32_t addr, uint32_t count, char *dest, size_t destsz,
6954                                     uint32_t *psys, uint32_t *psoft)
6955 {
6956   uint8_t ch;
6957   uint32_t dpos;
6958   ufo_assert(dest != NULL);
6959   ufo_assert(destsz > 0);
6960
6961   while (count != 0) {
6962     ch = ufoImgGetU8(addr);
6963     if (ch == '!') {
6964       //if (system) ufoFatal("invalid file name (duplicate system mark)");
6965       *psys = 1;
6966     } else if (ch == '?') {
6967       //if (softinclude) ufoFatal("invalid file name (duplicate soft mark)");
6968       *psoft = 1;
6969     } else {
6970       break;
6971     }
6972     do {
6973       addr += 1; count -= 1;
6974       ch = ufoImgGetU8(addr);
6975     } while (ch <= 32 && count != 0);
6976   }
6977
6978   if (count == 0) ufoFatal("empty include file name");
6979   if (count >= destsz) ufoFatal("include file name too long");
6980
6981   dpos = 0;
6982   while (count != 0) {
6983     dest[dpos] = (char)ufoImgGetU8(addr); dpos += 1;
6984     addr += 1; count -= 1;
6985   }
6986   dest[dpos] = 0;
6987 }
6988
6989
6990 // (INCLUDE-LINE-FOFS)
6991 // ( -- fofs )
6992 UFWORD(PAR_INCLUDE_LINE_FOFS) {
6993   ufoPush((uint32_t)(int32_t)ufoCurrIncludeLineFileOfs);
6994 }
6995
6996 // (INCLUDE-LINE-SEEK)
6997 // ( lidx fofs -- )
6998 UFWORD(PAR_INCLUDE_LINE_SEEK) {
6999   uint32_t fofs = ufoPop();
7000   uint32_t lidx = ufoPop();
7001   if (lidx >= 0x0fffffffU) lidx = 0;
7002   if (ufoInFile == NULL) ufoFatal("cannot seek without opened include file");
7003   if (fseek(ufoInFile, (long)fofs, SEEK_SET) != 0) {
7004     ufoFatal("error seeking in include file");
7005   }
7006   ufoInFileLine = lidx;
7007 }
7008
7009 // (INCLUDE-DEPTH)
7010 // ( -- depth )
7011 // return number of items in include stack
7012 UFWORD(PAR_INCLUDE_DEPTH) {
7013   ufoPush(ufoFileStackPos);
7014 }
7015
7016 // (INCLUDE-FILE-ID)
7017 // ( isp -- id ) -- isp 0 is current, then 1, etc.
7018 // each include file has unique non-zero id.
7019 UFWORD(PAR_INCLUDE_FILE_ID) {
7020   const uint32_t isp = ufoPop();
7021   if (isp == 0) {
7022     ufoPush(ufoFileId);
7023   } else if (isp <= ufoFileStackPos) {
7024     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
7025     ufoPush(stk->id);
7026   } else {
7027     ufoFatal("invalid include stack index");
7028   }
7029 }
7030
7031 // (INCLUDE-FILE-LINE)
7032 // ( isp -- line )
7033 UFWORD(PAR_INCLUDE_FILE_LINE) {
7034   const uint32_t isp = ufoPop();
7035   if (isp == 0) {
7036     ufoPush(ufoInFileLine);
7037   } else if (isp <= ufoFileStackPos) {
7038     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
7039     ufoPush(stk->fline);
7040   } else {
7041     ufoFatal("invalid include stack index");
7042   }
7043 }
7044
7045 // (INCLUDE-FILE-NAME)
7046 // ( isp -- addr count )
7047 // current file name; at PAD
7048 UFWORD(PAR_INCLUDE_FILE_NAME) {
7049   const uint32_t isp = ufoPop();
7050   const char *fname = NULL;
7051   if (isp == 0) {
7052     fname = ufoInFileName;
7053   } else if (isp <= ufoFileStackPos) {
7054     UFOFileStackEntry *stk = &ufoFileStack[ufoFileStackPos - isp];
7055     fname = stk->fname;
7056   } else {
7057     ufoFatal("invalid include stack index");
7058   }
7059   uint32_t addr = UFO_PAD_ADDR + 4u;
7060   uint32_t count = 0;
7061   if (fname != NULL) {
7062     while (fname[count] != 0) {
7063       ufoImgPutU8(addr + count, ((const unsigned char *)fname)[count]);
7064       count += 1;
7065     }
7066   }
7067   ufoImgPutU32(addr - 4u, count);
7068   ufoImgPutU8(addr + count, 0);
7069   ufoPush(addr);
7070   ufoPush(count);
7071 }
7072
7073
7074 // (INCLUDE-BUILD-NAME)
7075 // ( addr count soft? system? -- addr count )
7076 // to PAD
7077 UFWORD(PAR_INCLUDE_BUILD_NAME) {
7078   uint32_t system = ufoPop();
7079   uint32_t softinclude = ufoPop();
7080   uint32_t count = ufoPop();
7081   uint32_t addr = ufoPop();
7082
7083   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid include name");
7084
7085   ufoScanIncludeFileName(addr, count, ufoFNameBuf, sizeof(ufoFNameBuf),
7086                          &system, &softinclude);
7087
7088   char *ffn = ufoCreateIncludeName(ufoFNameBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
7089   addr = UFO_PAD_ADDR + 4u;
7090   count = 0;
7091   while (ffn[count] != 0) {
7092     ufoImgPutU8(addr + count, ((const unsigned char *)ffn)[count]);
7093     count += 1u;
7094   }
7095   free(ffn);
7096   ufoImgPutU8(addr + count, 0);
7097   ufoImgPutU32(addr - 4u, count);
7098   ufoPush(addr);
7099   ufoPush(count);
7100 }
7101
7102 // (INCLUDE-NO-REFILL)
7103 // ( addr count soft? system? -- )
7104 UFWORD(PAR_INCLUDE_NO_REFILL) {
7105   uint32_t system = ufoPop();
7106   uint32_t softinclude = ufoPop();
7107   uint32_t count = ufoPop();
7108   uint32_t addr = ufoPop();
7109
7110   if (ufoMode == UFO_MODE_MACRO) ufoFatal("macros cannot include files");
7111
7112   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid include name");
7113
7114   ufoScanIncludeFileName(addr, count, ufoFNameBuf, sizeof(ufoFNameBuf),
7115                          &system, &softinclude);
7116
7117   char *ffn = ufoCreateIncludeName(ufoFNameBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
7118   #ifdef WIN32
7119   FILE *fl = fopen(ffn, "rb");
7120   #else
7121   FILE *fl = fopen(ffn, "r");
7122   #endif
7123   if (!fl) {
7124     if (softinclude) { free(ffn); return; }
7125     ufoFatal("include file '%s' not found", ffn);
7126   }
7127   #ifdef UFO_DEBUG_INCLUDE
7128   fprintf(stderr, "INC-PUSH: new fname: %s\n", ffn);
7129   #endif
7130   ufoPushInFile();
7131   ufoInFile = fl;
7132   ufoInFileLine = 0;
7133   ufoSetInFileNameReuse(ffn);
7134   ufoFileId = ufoLastUsedFileId;
7135   setLastIncPath(ufoInFileName, system);
7136 }
7137
7138 // (INCLUDE-DROP)
7139 // ( -- )
7140 UFWORD(PAR_INCLUDE_DROP) {
7141   ufoPopInFile();
7142 }
7143
7144 // (INCLUDE)
7145 // ( addr count soft? system? -- )
7146 UFWORD(PAR_INCLUDE) {
7147   UFCALL(PAR_INCLUDE_NO_REFILL);
7148   // trigger next line loading
7149   UFCALL(REFILL);
7150   if (!ufoPop()) ufoFatal("(INCLUDE) internal error");
7151 }
7152
7153 // $INCLUDE "str"
7154 UFWORD(DLR_INCLUDE_IMM) {
7155   int soft = 0, system = 0;
7156   // parse include filename
7157   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
7158   uint8_t ch = ufoTibPeekCh();
7159   if (ch == '"') {
7160     ufoTibSkipCh(); // skip quote
7161     ufoPush(34);
7162   } else if (ch == '<') {
7163     ufoTibSkipCh(); // skip quote
7164     ufoPush(62);
7165     system = 1;
7166   } else {
7167     ufoFatal("expected quoted string");
7168   }
7169   UFCALL(PARSE);
7170   if (!ufoPop()) ufoFatal("file name expected");
7171   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
7172   if (ufoTibPeekCh() != 0) {
7173     ufoFatal("$INCLUDE doesn't accept extra args yet");
7174   }
7175   // ( addr count soft? system? -- )
7176   ufoPushBool(soft); ufoPushBool(system); UFCALL(PAR_INCLUDE);
7177 }
7178
7179
7180 //==========================================================================
7181 //
7182 //  ufoCreateFileGuard
7183 //
7184 //==========================================================================
7185 static const char *ufoCreateFileGuard (const char *fname) {
7186   if (fname == NULL || fname[0] == 0) return NULL;
7187   char *rp = ufoRealPath(fname);
7188   if (rp == NULL) return NULL;
7189   #ifdef WIN32
7190   for (char *s = rp; *s; s += 1) if (*s == '\\') *s = '/';
7191   #endif
7192   // hash the buffer; extract file name; create string with path len, file name, and hash
7193   const size_t orgplen = strlen(rp);
7194   const uint32_t phash = joaatHashBuf(rp, orgplen, 0);
7195   size_t plen = orgplen;
7196   while (plen != 0 && rp[plen - 1u] != '/') plen -= 1;
7197   snprintf(ufoRealPathHashBuf, sizeof(ufoRealPathHashBuf),
7198            "__INCLUDE_GUARD_%08X_%08X_%s__", phash, (uint32_t)orgplen, rp + plen);
7199   return ufoRealPathHashBuf;
7200 }
7201
7202
7203 // $INCLUDE-ONCE "str"
7204 // includes file only once; unreliable on shitdoze, i believe
7205 UFWORD(DLR_INCLUDE_ONCE_IMM) {
7206   uint32_t softinclude = 0, system = 0;
7207   // parse include filename
7208   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
7209   uint8_t ch = ufoTibPeekCh();
7210   if (ch == '"') {
7211     ufoTibSkipCh(); // skip quote
7212     ufoPush(34);
7213   } else if (ch == '<') {
7214     ufoTibSkipCh(); // skip quote
7215     ufoPush(62);
7216     system = 1;
7217   } else {
7218     ufoFatal("expected quoted string");
7219   }
7220   UFCALL(PARSE);
7221   if (!ufoPop()) ufoFatal("file name expected");
7222   const uint32_t count = ufoPop();
7223   const uint32_t addr = ufoPop();
7224   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
7225   if (ufoTibPeekCh() != 0) {
7226     ufoFatal("$REQUIRE doesn't accept extra args yet");
7227   }
7228   ufoScanIncludeFileName(addr, count, ufoRealPathHashBuf, sizeof(ufoRealPathHashBuf),
7229                          &system, &softinclude);
7230   char *incfname = ufoCreateIncludeName(ufoRealPathHashBuf, system, (system ? ufoLastSysIncPath : ufoLastIncPath));
7231   if (incfname == NULL) ufoFatal("cannot resolve include file '%s'", ufoRealPathHashBuf);
7232   //fprintf(stderr, "?:%d;!:%d;%s|%s\n", softinclude, system, ufoRealPathHashBuf, incfname);
7233   // this will overwrite `ufoRealPathHashBuf`
7234   const char *guard = ufoCreateFileGuard(incfname);
7235   free(incfname);
7236   if (guard == NULL) {
7237     if (!softinclude) ufoFatal("cannot include file '%s'", ufoRealPathHashBuf);
7238     return;
7239   }
7240   #if 0
7241   fprintf(stderr, "GUARD: <%s>\n", guard);
7242   #endif
7243   // now check for the guard
7244   const uint32_t glen = (uint32_t)strlen(guard);
7245   const uint32_t ghash = joaatHashBuf(guard, glen, 0);
7246   UForthCondDefine *dd;
7247   for (dd = ufoCondDefines; dd != NULL; dd = dd->next) {
7248     if (dd->hash == ghash && dd->namelen == glen && strcmp(guard, dd->name) == 0) {
7249       // nothing to do: already included
7250       return;
7251     }
7252   }
7253   // add guard
7254   dd = calloc(1, sizeof(UForthCondDefine));
7255   if (dd == NULL) ufoFatal("out of memory for defines");
7256   dd->name = calloc(1, glen + 1u);
7257   if (dd->name == NULL) { free(dd); ufoFatal("out of memory for defines"); }
7258   strcpy(dd->name, guard);
7259   dd->namelen = glen;
7260   dd->hash = ghash;
7261   dd->next = ufoCondDefines;
7262   ufoCondDefines = dd;
7263   // ( addr count soft? system? -- )
7264   ufoPush(addr); ufoPush(count); ufoPushBool(softinclude); ufoPushBool(system);
7265   UFCALL(PAR_INCLUDE);
7266 }
7267
7268
7269 // ////////////////////////////////////////////////////////////////////////// //
7270 // handles
7271 //
7272
7273 // HANDLE:NEW
7274 // ( typeid -- hx )
7275 UFWORD(PAR_NEW_HANDLE) {
7276   const uint32_t typeid = ufoPop();
7277   if (typeid == UFO_HANDLE_FREE) ufoFatal("invalid handle typeid");
7278   UfoHandle *hh = ufoAllocHandle(typeid);
7279   ufoPush(hh->ufoHandle);
7280 }
7281
7282 // HANDLE:FREE
7283 // ( hx -- )
7284 UFWORD(PAR_FREE_HANDLE) {
7285   const uint32_t hx = ufoPop();
7286   if (hx != 0) {
7287     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("trying to free something that is not a handle");
7288     UfoHandle *hh = ufoGetHandle(hx);
7289     if (hh == NULL) ufoFatal("trying to free invalid handle");
7290     ufoFreeHandle(hh);
7291   }
7292 }
7293
7294 // HANDLE:TYPEID@
7295 // ( hx -- typeid )
7296 UFWORD(PAR_HANDLE_GET_TYPEID) {
7297   const uint32_t hx = ufoPop();
7298   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
7299   UfoHandle *hh = ufoGetHandle(hx);
7300   if (hh == NULL) ufoFatal("invalid handle");
7301   ufoPush(hh->typeid);
7302 }
7303
7304 // HANDLE:TYPEID!
7305 // ( typeid hx -- )
7306 UFWORD(PAR_HANDLE_SET_TYPEID) {
7307   const uint32_t hx = ufoPop();
7308   const uint32_t typeid = ufoPop();
7309   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
7310   if (typeid == UFO_HANDLE_FREE) ufoFatal("invalid handle typeid");
7311   UfoHandle *hh = ufoGetHandle(hx);
7312   if (hh == NULL) ufoFatal("invalid handle");
7313   hh->typeid = typeid;
7314 }
7315
7316 // HANDLE:SIZE@
7317 // ( hx -- size )
7318 UFWORD(PAR_HANDLE_GET_SIZE) {
7319   const uint32_t hx = ufoPop();
7320   if (hx != 0) {
7321     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
7322     UfoHandle *hh = ufoGetHandle(hx);
7323     if (hh == NULL) ufoFatal("invalid handle");
7324     ufoPush(hh->size);
7325   } else {
7326     ufoPush(0);
7327   }
7328 }
7329
7330 // HANDLE:SIZE!
7331 // ( size hx -- )
7332 UFWORD(PAR_HANDLE_SET_SIZE) {
7333   const uint32_t hx = ufoPop();
7334   const uint32_t size = ufoPop();
7335   if (size > 0x04000000) ufoFatal("invalid handle size");
7336   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
7337   UfoHandle *hh = ufoGetHandle(hx);
7338   if (hh == NULL) ufoFatal("invalid handle");
7339   if (hh->size != size) {
7340     if (size == 0) {
7341       free(hh->data);
7342       hh->data = NULL;
7343     } else {
7344       uint8_t *nx = realloc(hh->data, size * sizeof(hh->data[0]));
7345       if (nx == NULL) ufoFatal("out of memory for handle of size %u", size);
7346       hh->data = nx;
7347       if (size > hh->size) memset(hh->data, 0, size - hh->size);
7348     }
7349     hh->size = size;
7350     if (hh->used > size) hh->used = size;
7351   }
7352 }
7353
7354 // HANDLE:USED@
7355 // ( hx -- used )
7356 UFWORD(PAR_HANDLE_GET_USED) {
7357   const uint32_t hx = ufoPop();
7358   if (hx != 0) {
7359     if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
7360     UfoHandle *hh = ufoGetHandle(hx);
7361     if (hh == NULL) ufoFatal("invalid handle");
7362     ufoPush(hh->used);
7363   } else {
7364     ufoPush(0);
7365   }
7366 }
7367
7368 // HANDLE:USED!
7369 // ( size hx -- )
7370 UFWORD(PAR_HANDLE_SET_USED) {
7371   const uint32_t hx = ufoPop();
7372   const uint32_t used = ufoPop();
7373   if (used > 0x04000000) ufoFatal("invalid handle used");
7374   if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle");
7375   UfoHandle *hh = ufoGetHandle(hx);
7376   if (hh == NULL) ufoFatal("invalid handle");
7377   if (used > hh->size) ufoFatal("handle used %u out of range (%u)", used, hh->size);
7378   hh->used = used;
7379 }
7380
7381 #define POP_PREPARE_HANDLE() \
7382   const uint32_t hx = ufoPop(); \
7383   uint32_t idx = ufoPop()
7384
7385
7386 // HANDLE:C@
7387 // ( idx hx -- value )
7388 UFWORD(PAR_HANDLE_LOAD_BYTE) {
7389   POP_PREPARE_HANDLE();
7390   ufoPush(ufoHandleLoadByte(hx, idx));
7391 }
7392
7393 // HANDLE:W@
7394 // ( idx hx -- value )
7395 UFWORD(PAR_HANDLE_LOAD_WORD) {
7396   POP_PREPARE_HANDLE();
7397   ufoPush(ufoHandleLoadWord(hx, idx));
7398 }
7399
7400 // HANDLE:@
7401 // ( idx hx -- value )
7402 UFWORD(PAR_HANDLE_LOAD_CELL) {
7403   POP_PREPARE_HANDLE();
7404   ufoPush(ufoHandleLoadCell(hx, idx));
7405 }
7406
7407 // HANDLE:C!
7408 // ( value idx hx -- value )
7409 UFWORD(PAR_HANDLE_STORE_BYTE) {
7410   POP_PREPARE_HANDLE();
7411   const uint32_t value = ufoPop();
7412   ufoHandleStoreByte(hx, idx, value);
7413 }
7414
7415 // HANDLE:W!
7416 // ( value idx hx -- )
7417 UFWORD(PAR_HANDLE_STORE_WORD) {
7418   POP_PREPARE_HANDLE();
7419   const uint32_t value = ufoPop();
7420   ufoHandleStoreWord(hx, idx, value);
7421 }
7422
7423 // HANDLE:!
7424 // ( value idx hx -- )
7425 UFWORD(PAR_HANDLE_STORE_CELL) {
7426   POP_PREPARE_HANDLE();
7427   const uint32_t value = ufoPop();
7428   ufoHandleStoreCell(hx, idx, value);
7429 }
7430
7431
7432 // HANDLE:LOAD-FILE
7433 // ( addr count -- stx / FALSE )
7434 UFWORD(PAR_HANDLE_LOAD_FILE) {
7435   uint32_t count = ufoPop();
7436   uint32_t addr = ufoPop();
7437
7438   if ((count & ((uint32_t)1<<31)) != 0) ufoFatal("invalid file name");
7439
7440   uint8_t *dest = (uint8_t *)ufoFNameBuf;
7441   while (count != 0 && dest < (uint8_t *)ufoFNameBuf + sizeof(ufoFNameBuf)) {
7442     uint8_t ch = ufoImgGetU8(addr);
7443     *dest = ch;
7444     dest += 1u; addr += 1u; count -= 1u;
7445   }
7446   if (dest == (uint8_t *)ufoFNameBuf + sizeof(ufoFNameBuf)) ufoFatal("file name too long");
7447   *dest = 0;
7448
7449   if (*ufoFNameBuf == 0) ufoFatal("empty file name");
7450
7451   char *ffn = ufoCreateIncludeName(ufoFNameBuf, 0/*system*/, ufoLastIncPath);
7452   #ifdef WIN32
7453   FILE *fl = fopen(ffn, "rb");
7454   #else
7455   FILE *fl = fopen(ffn, "r");
7456   #endif
7457   if (!fl) {
7458     free(ffn);
7459     ufoPush(0);
7460     return;
7461   }
7462
7463   if (fseek(fl, 0, SEEK_END) != 0) {
7464     fclose(fl);
7465     ufoFatal("seek error in file '%s'", ffn);
7466   }
7467
7468   long sz = ftell(fl);
7469   if (sz < 0 || sz >= 1024 * 1024 * 64) {
7470     fclose(fl);
7471     ufoFatal("tell error in file '%s' (or too big)", ffn);
7472   }
7473
7474   if (fseek(fl, 0, SEEK_SET) != 0) {
7475     fclose(fl);
7476     ufoFatal("seek error in file '%s'", ffn);
7477   }
7478
7479   UfoHandle *hh = ufoAllocHandle(0);
7480   if (sz != 0) {
7481     hh->data = malloc((uint32_t)sz);
7482     if (hh->data == NULL) {
7483       fclose(fl);
7484       ufoFatal("out of memory for file '%s'", ffn);
7485     }
7486     hh->size = (uint32_t)sz;
7487     if (fread(hh->data, (uint32_t)sz, 1, fl) != 1) {
7488       fclose(fl);
7489       ufoFatal("error reading file '%s'", ffn);
7490     }
7491     fclose(fl);
7492   }
7493
7494   free(ffn);
7495   ufoPush(hh->ufoHandle);
7496 }
7497
7498
7499 // ////////////////////////////////////////////////////////////////////////// //
7500 // utils
7501 //
7502
7503 #ifdef UFO_MTASK_ALLOWED
7504 #define UFO_MTASK_POP_STATE()  \
7505   UfoState *st = ufoFindState(ufoPop()); \
7506   if (st == NULL) ufoFatal("unknown state")
7507 #else
7508 #define UFO_MTASK_POP_STATE()  \
7509   if (ufoPop() != 0) ufoFatal("no multitasking support compiled in"); \
7510   UfoState *st = &ufoCurrState
7511 #endif
7512
7513 // DEBUG:(DECOMPILE-CFA)
7514 // ( cfa -- )
7515 UFWORD(DEBUG_DECOMPILE_CFA) {
7516   const uint32_t cfa = ufoPop();
7517   ufoFlushOutput();
7518   ufoDecompileWord(cfa);
7519 }
7520
7521 // DEBUG:(DECOMPILE-MEM)
7522 // ( addr-start addr-end -- )
7523 UFWORD(DEBUG_DECOMPILE_MEM) {
7524   const uint32_t end = ufoPop();
7525   const uint32_t start = ufoPop();
7526   ufoFlushOutput();
7527   ufoDecompilePart(start, end, 0);
7528 }
7529
7530 // GET-MSECS
7531 // ( -- u32 )
7532 UFWORD(GET_MSECS) {
7533   ufoPush((uint32_t)ufo_get_msecs());
7534 }
7535
7536 // this is called by INTERPRET when it is out of input stream
7537 UFWORD(UFO_INTERPRET_FINISHED_ACTION) {
7538   longjmp(ufoStopVMJP, 666);
7539 }
7540
7541 #ifdef UFO_MTASK_ALLOWED
7542 // MTASK:NEW-STATE
7543 // ( cfa -- stid )
7544 UFWORD(MT_NEW_STATE) {
7545   UfoState *st = ufoNewState();
7546   const uint32_t cfa = ufoPop();
7547   const uint32_t cfaidx = ufoImgGetU32(cfa);
7548   if (cfaidx != ufoDoForthCFA) ufoFatal("state starting word should be in Forth");
7549   ufoInitStateUserVars(st);
7550   st->ip = UFO_CFA_TO_PFA(cfa);
7551   st->rStack[0] = 0xdeadf00d; // dummy value
7552   st->RP = 1;
7553   ufoPush(st->id);
7554 }
7555
7556 // MTASK:FREE-STATE
7557 // ( stid -- )
7558 UFWORD(MT_FREE_STATE) {
7559   UfoState *st = ufoFindState(ufoPop());
7560   if (st == NULL) ufoFatal("cannot free unknown state");
7561   if (st == ufoCurrState) ufoFatal("cannot free current state");
7562   ufoFreeState(st);
7563 }
7564 #endif
7565
7566 // MTASK:STATE-NAME@
7567 // ( stid -- addr count )
7568 // to PAD
7569 UFWORD(MT_GET_STATE_NAME) {
7570   UFO_MTASK_POP_STATE();
7571   uint32_t addr = UFO_PAD_ADDR;
7572   uint32_t count = 0;
7573   while (st->name[count] != 0) {
7574     ufoImgPutU8(addr + count, ((const unsigned char *)st->name)[count]);
7575     count += 1u;
7576   }
7577   ufoImgPutU8(addr + count, 0);
7578   ufoPush(addr);
7579   ufoPush(count);
7580 }
7581
7582 // MTASK:STATE-NAME!
7583 // ( addr count stid -- )
7584 UFWORD(MT_SET_STATE_NAME) {
7585   UFO_MTASK_POP_STATE();
7586   uint32_t count = ufoPop();
7587   uint32_t addr = ufoPop();
7588   if ((count & ((uint32_t)1 << 31)) == 0) {
7589     if (count > UFO_MAX_TASK_NAME) ufoFatal("task name too long");
7590     for (uint32_t f = 0; f < count; f += 1u) {
7591       ((unsigned char *)st->name)[f] = ufoImgGetU8(addr + f);
7592     }
7593     st->name[count] = 0;
7594   }
7595 }
7596
7597 #ifdef UFO_MTASK_ALLOWED
7598 // MTASK:STATE-FIRST
7599 // ( -- stid )
7600 UFWORD(MT_STATE_FIRST) {
7601   uint32_t fidx = 0;
7602   while (fidx != (uint32_t)(UFO_MAX_STATES/32) && ufoStateUsedBitmap[fidx] == 0) fidx += 1u;
7603   // there should be at least one allocated state
7604   ufo_assert(fidx != (uint32_t)(UFO_MAX_STATES/32));
7605   uint32_t bmp = ufoStateUsedBitmap[fidx];
7606   fidx *= 32u;
7607   while ((bmp & 0x01) == 0) { fidx += 1u; bmp >>= 1; }
7608   ufoPush(fidx + 1u);
7609 }
7610
7611 // MTASK:STATE-NEXT
7612 // ( stid -- stid / 0 )
7613 UFWORD(MT_STATE_NEXT) {
7614   uint32_t stid = ufoPop();
7615   if (stid != 0 && stid < (uint32_t)(UFO_MAX_STATES/32)) {
7616     // it is already incremented for us, yay!
7617     uint32_t fidx = stid / 32u;
7618     uint8_t fofs = stid & 0x1f;
7619     while (fidx < (uint32_t)(UFO_MAX_STATES/32)) {
7620       const uint32_t bmp = ufoStateUsedBitmap[fidx];
7621       if (bmp != 0) {
7622         while (fofs != 32u) {
7623           if ((bmp & ((uint32_t)1 << (fofs & 0x1f))) == 0) fofs += 1u;
7624         }
7625         if (fofs != 32u) {
7626           ufoPush(fidx * 32u + fofs + 1u);
7627           return; // sorry!
7628         }
7629       }
7630       fidx += 1u; fofs = 0;
7631     }
7632   }
7633   ufoPush(0);
7634 }
7635
7636 // MTASK:YIELD-TO
7637 // ( ... argc stid -- )
7638 UFWORD(MT_YIELD_TO) {
7639   UfoState *st = ufoFindState(ufoPop());
7640   if (st == NULL) ufoFatal("cannot yield to unknown state");
7641   //if (st == ufoDebuggerState) ufoFatal("cannot yield to debugger"); // why not?
7642   const uint32_t argc = ufoPop();
7643   if (argc > 256) ufoFatal("too many YIELD-TO arguments");
7644   UfoState *curst = ufoCurrState;
7645   if (st != ufoCurrState) {
7646     for (uint32_t f = 0; f < argc; f += 1) {
7647       ufoCurrState = curst;
7648       const uint32_t n = ufoPop();
7649       ufoCurrState = st;
7650       ufoPush(n);
7651     }
7652     ufoCurrState = curst; // we need to use API call to switch states
7653   }
7654   ufoSwitchToState(st); // always use API call for this!
7655   ufoPush(argc);
7656   ufoPush(curst->id);
7657 }
7658
7659 // MTASK:SET-SELF-AS-DEBUGGER
7660 // ( -- )
7661 UFWORD(MT_SET_SELF_AS_DEBUGGER) {
7662   ufoDebuggerState = ufoCurrState;
7663 }
7664
7665 // DEBUG:SINGLE-STEP@
7666 // ( -- enabled? )
7667 UFWORD(DBG_GET_SS) {
7668   ufoPush(ufoSingleStepAllowed);
7669 }
7670 #endif
7671
7672 // DEBUG:(BP)
7673 // ( -- )
7674 // debugger task receives debugge stid on the data stack, and -1 as argc.
7675 // i.e. debugger stask is: ( -1 old-stid )
7676 UFWORD(MT_DEBUGGER_BP) {
7677   #ifdef UFO_MTASK_ALLOWED
7678   if (ufoDebuggerState != NULL && ufoCurrState != ufoDebuggerState && ufoIsGoodTTY()) {
7679     UfoState *st = ufoCurrState;
7680     ufoSwitchToState(ufoDebuggerState); // always use API call for this!
7681     ufoPush(-1);
7682     ufoPush(st->id);
7683     ufoSingleStep = 0;
7684   } else {
7685     UFCALL(UFO_BACKTRACE);
7686   }
7687   #else
7688   UFCALL(UFO_BACKTRACE);
7689   #endif
7690 }
7691
7692 #ifdef UFO_MTASK_ALLOWED
7693 // MTASK:DEBUGGER-RESUME
7694 // ( stid -- )
7695 UFWORD(MT_RESUME_DEBUGEE) {
7696   if (ufoCurrState != ufoDebuggerState) ufoFatal("cannot resume from non-debugger");
7697   UfoState *st = ufoFindState(ufoPop());
7698   if (st == NULL) ufoFatal("cannot yield to unknown state");
7699   if (st == ufoCurrState) ufoFatal("cannot resume into debugger itself");
7700   ufoSwitchToState(st); // always use API call for this!
7701   ufoSingleStep = 0;
7702 }
7703
7704 // MTASK:DEBUGGER-SINGLE-STEP
7705 // ( stid -- )
7706 UFWORD(MT_SINGLE_STEP_DEBUGEE) {
7707   if (ufoCurrState != ufoDebuggerState) ufoFatal("cannot resume from non-debugger");
7708   UfoState *st = ufoFindState(ufoPop());
7709   if (st == NULL) ufoFatal("cannot yield to unknown state");
7710   if (st == ufoCurrState) ufoFatal("cannot resume into debugger itself");
7711   ufoSwitchToState(st); // always use API call for this!
7712   ufoSingleStep = 2; // it will be decremented after returning from this word
7713 }
7714 #endif
7715
7716 // MTASK:STATE-IP@
7717 // ( stid -- ip )
7718 UFWORD(MT_STATE_IP_GET) {
7719   UFO_MTASK_POP_STATE();
7720   ufoPush(st->IP);
7721 }
7722
7723 // MTASK:STATE-IP!
7724 // ( ip stid -- )
7725 UFWORD(MT_STATE_IP_SET) {
7726   UFO_MTASK_POP_STATE();
7727   st->IP = ufoPop();
7728 }
7729
7730 // MTASK:STATE-A>
7731 // ( stid -- ip )
7732 UFWORD(MT_STATE_REGA_GET) {
7733   UFO_MTASK_POP_STATE();
7734   ufoPush(st->regA);
7735 }
7736
7737 // MTASK:STATE->A
7738 // ( ip stid -- )
7739 UFWORD(MT_STATE_REGA_SET) {
7740   UFO_MTASK_POP_STATE();
7741   st->regA = ufoPop();
7742 }
7743
7744 // MTASK:STATE-USER@
7745 // ( addr stid -- value )
7746 UFWORD(MT_STATE_USER_GET) {
7747   UFO_MTASK_POP_STATE();
7748   const uint32_t addr = ufoPop();
7749   if ((addr & UFO_ADDR_TEMP_BIT) != 0 && (addr & UFO_ADDR_TEMP_MASK) + 3u < ufoSTImageTempSize(st)) {
7750     uint32_t v = *(const uint32_t *)((const uint8_t *)st->imageTemp + (addr & UFO_ADDR_TEMP_MASK));
7751     ufoPush(v);
7752   } else {
7753     ufoFatal("invalid user area address");
7754   }
7755 }
7756
7757 // MTASK:STATE-USER!
7758 // ( value addr stid -- )
7759 UFWORD(MT_STATE_USER_SET) {
7760   UFO_MTASK_POP_STATE();
7761   const uint32_t addr = ufoPop();
7762   const uint32_t value = ufoPop();
7763   if ((addr & UFO_ADDR_TEMP_BIT) != 0 && (addr & UFO_ADDR_TEMP_MASK) + 3u < ufoSTImageTempSize(st)) {
7764     *(uint32_t *)((const uint8_t *)st->imageTemp + (addr & UFO_ADDR_TEMP_MASK)) = value;
7765   } else {
7766     ufoFatal("invalid user area address");
7767   }
7768 }
7769
7770 // MTASK:ACTIVE-STATE
7771 // ( -- stid )
7772 UFWORD(MT_ACTIVE_STATE) {
7773   #ifdef UFO_MTASK_ALLOWED
7774   ufoPush(ufoCurrState->id);
7775   #else
7776   ufoPush(0);
7777   #endif
7778 }
7779
7780 // MTASK:YIELDED-FROM
7781 // ( -- stid / 0 )
7782 UFWORD(MT_YIELDED_FROM) {
7783   #ifdef UFO_MTASK_ALLOWED
7784   if (ufoYieldedState != NULL) {
7785     ufoPush(ufoYieldedState->id);
7786   } else {
7787     ufoPush(0);
7788   }
7789   #else
7790   ufoPush(0);
7791   #endif
7792 }
7793
7794 // MTASK:STATE-SP@
7795 // ( stid -- depth )
7796 UFWORD(MT_DSTACK_DEPTH_GET) {
7797   UFO_MTASK_POP_STATE();
7798   ufoPush(st->SP);
7799 }
7800
7801 // MTASK:STATE-RP@
7802 // ( stid -- depth )
7803 UFWORD(MT_RSTACK_DEPTH_GET) {
7804   UFO_MTASK_POP_STATE();
7805   ufoPush(st->RP);
7806 }
7807
7808 // MTASK:STATE-LP@
7809 // ( stid -- lp )
7810 UFWORD(MT_LP_GET) {
7811   UFO_MTASK_POP_STATE();
7812   ufoPush(st->LP);
7813 }
7814
7815 // MTASK:STATE-LBP@
7816 // ( stid -- lbp )
7817 UFWORD(MT_LBP_GET) {
7818   UFO_MTASK_POP_STATE();
7819   ufoPush(st->LBP);
7820 }
7821
7822 // MTASK:STATE-SP!
7823 // ( depth stid -- )
7824 UFWORD(MT_DSTACK_DEPTH_SET) {
7825   UFO_MTASK_POP_STATE();
7826   const uint32_t idx = ufoPop();
7827   if (idx >= UFO_DSTACK_SIZE) ufoFatal("invalid stack index %u (%u)", idx, UFO_DSTACK_SIZE);
7828   st->SP = idx;
7829 }
7830
7831 // MTASK:STATE-RP!
7832 // ( depth stid -- )
7833 UFWORD(MT_RSTACK_DEPTH_SET) {
7834   UFO_MTASK_POP_STATE();
7835   const uint32_t idx = ufoPop();
7836   const uint32_t left = UFO_RSTACK_SIZE;
7837   if (idx >= left) ufoFatal("invalid rstack index %u (%u)", idx, left);
7838   st->RP = idx;
7839 }
7840
7841 // MTASK:STATE-LP!
7842 // ( lp stid -- )
7843 UFWORD(MT_LP_SET) {
7844   UFO_MTASK_POP_STATE();
7845   st->LP = ufoPop();
7846 }
7847
7848 // MTASK:STATE-LBP!
7849 // ( lbp stid -- )
7850 UFWORD(MT_LBP_SET) {
7851   UFO_MTASK_POP_STATE();
7852   st->LBP = ufoPop();
7853 }
7854
7855 // MTASK:STATE-DS@
7856 // ( idx stid -- value )
7857 UFWORD(MT_DSTACK_LOAD) {
7858   UFO_MTASK_POP_STATE();
7859   const uint32_t idx = ufoPop();
7860   if (idx >= st->SP) ufoFatal("invalid stack index %u (%u)", idx, st->SP);
7861   ufoPush(st->dStack[st->SP - idx - 1u]);
7862 }
7863
7864 // MTASK:STATE-RS@
7865 // ( idx stid -- value )
7866 UFWORD(MT_RSTACK_LOAD) {
7867   UFO_MTASK_POP_STATE();
7868   const uint32_t idx = ufoPop();
7869   if (idx >= st->RP) ufoFatal("invalid stack index %u (%u)", idx, st->RP);
7870   ufoPush(st->dStack[st->RP - idx - 1u]);
7871 }
7872
7873 // MTASK:STATE-LS@
7874 // ( idx stid -- value )
7875 UFWORD(MT_LSTACK_LOAD) {
7876   UFO_MTASK_POP_STATE();
7877   const uint32_t idx = ufoPop();
7878   if (idx >= st->LP) ufoFatal("invalid lstack index %u (%u)", idx, st->LP);
7879   ufoPush(st->lStack[st->LP - idx - 1u]);
7880 }
7881
7882 // MTASK:STATE-DS!
7883 // ( value idx stid -- )
7884 UFWORD(MT_DSTACK_STORE) {
7885   UFO_MTASK_POP_STATE();
7886   const uint32_t idx = ufoPop();
7887   const uint32_t value = ufoPop();
7888   if (idx >= st->SP) ufoFatal("invalid stack index %u (%u)", idx, st->SP);
7889   st->dStack[st->SP - idx - 1u] = value;
7890 }
7891
7892 // MTASK:STATE-RS!
7893 // ( value idx stid -- )
7894 UFWORD(MT_RSTACK_STORE) {
7895   UFO_MTASK_POP_STATE();
7896   const uint32_t idx = ufoPop();
7897   const uint32_t value = ufoPop();
7898   if (idx >= st->RP) ufoFatal("invalid stack index %u (%u)", idx, st->RP);
7899   st->dStack[st->RP - idx - 1u] = value;
7900 }
7901
7902 // MTASK:STATE-LS!
7903 // ( value idx stid -- )
7904 UFWORD(MT_LSTACK_STORE) {
7905   UFO_MTASK_POP_STATE();
7906   const uint32_t idx = ufoPop();
7907   const uint32_t value = ufoPop();
7908   if (idx >= st->LP) ufoFatal("invalid stack index %u (%u)", idx, st->LP);
7909   st->dStack[st->LP - idx - 1u] = value;
7910 }
7911
7912 // MTASK:STATE-VSP@
7913 // ( stid -- vsp )
7914 UFWORD(MT_VSP_GET) {
7915   UFO_MTASK_POP_STATE();
7916   ufoPush(st->VSP);
7917 }
7918
7919 // MTASK:STATE-VSP!
7920 // ( vsp stid -- )
7921 UFWORD(MT_VSP_SET) {
7922   UFO_MTASK_POP_STATE();
7923   const uint32_t vsp = ufoPop();
7924   if (vsp > UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
7925   st->VSP = vsp;
7926 }
7927
7928 // MTASK:STATE-VSP-AT@
7929 // ( idx stidf -- value )
7930 UFWORD(MT_VSP_LOAD) {
7931   UFO_MTASK_POP_STATE();
7932   const uint32_t vsp = ufoPop();
7933   if (vsp >= UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
7934   ufoPush(st->vocStack[vsp]);
7935 }
7936
7937 // MTASK:STATE-VSP-AT!
7938 // ( value idx stid -- )
7939 UFWORD(MT_VSP_STORE) {
7940   UFO_MTASK_POP_STATE();
7941   const uint32_t vsp = ufoPop();
7942   const uint32_t value = ufoPop();
7943   if (vsp > UFO_VOCSTACK_SIZE) ufoFatal("VSP %u out of range (%u)", vsp, UFO_VOCSTACK_SIZE);
7944   st->vocStack[vsp] = value;
7945 }
7946
7947
7948 #include "urforth_tty.c"
7949
7950
7951 // ////////////////////////////////////////////////////////////////////////// //
7952 // "FILES" words
7953 //
7954
7955 static unsigned char ufoFileIOBuffer[4096];
7956
7957
7958 //==========================================================================
7959 //
7960 //  ufoPopFileName
7961 //
7962 //==========================================================================
7963 static char *ufoPopFileName (void) {
7964   uint32_t count = ufoPop();
7965   uint32_t addr = ufoPop();
7966
7967   if ((count & 0x80000000U) != 0) ufoFatal("invalid file name");
7968   if (count == 0) ufoFatal("empty file name");
7969   if (count > (uint32_t)sizeof(ufoFNameBuf) - 1u) ufoFatal("file name too long");
7970
7971   unsigned char *dest = (unsigned char *)ufoFNameBuf;
7972   while (count != 0) {
7973     *dest = ufoImgGetU8(addr);
7974     dest += 1u; addr += 1u; count -= 1u;
7975   }
7976   *dest = 0;
7977
7978   return ufoFNameBuf;
7979 }
7980
7981 // FILES:ERRNO
7982 // ( -- errno )
7983 UFWORD(FILES_ERRNO) {
7984   ufoPush((uint32_t)errno);
7985 }
7986
7987 // FILES:UNLINK
7988 // ( addr count -- success? )
7989 UFWORD(FILES_UNLINK) {
7990   const char *fname = ufoPopFileName();
7991   ufoPushBool(unlink(fname) == 0);
7992 }
7993
7994 // FILES:OPEN-R/O
7995 // ( addr count -- handle TRUE / FALSE )
7996 UFWORD(FILES_OPEN_RO) {
7997   const char *fname = ufoPopFileName();
7998   const int fd = open(fname, O_RDONLY);
7999   if (fd >= 0) {
8000     ufoPush((uint32_t)fd);
8001     ufoPushBool(1);
8002   } else {
8003     ufoPushBool(0);
8004   }
8005 }
8006
8007 // FILES:OPEN-R/W
8008 // ( addr count -- handle TRUE / FALSE )
8009 UFWORD(FILES_OPEN_RW) {
8010   const char *fname = ufoPopFileName();
8011   const int fd = open(fname, O_RDWR);
8012   if (fd >= 0) {
8013     ufoPush((uint32_t)fd);
8014     ufoPushBool(1);
8015   } else {
8016     ufoPushBool(0);
8017   }
8018 }
8019
8020 // FILES:CREATE
8021 // ( addr count -- handle TRUE / FALSE )
8022 UFWORD(FILES_CREATE) {
8023   const char *fname = ufoPopFileName();
8024   //FIXME: add variable with default flags
8025   const int fd = open(fname, O_RDWR|O_CREAT|O_TRUNC, 0644);
8026   if (fd >= 0) {
8027     ufoPush((uint32_t)fd);
8028     ufoPushBool(1);
8029   } else {
8030     ufoPushBool(0);
8031   }
8032 }
8033
8034 // FILES:CLOSE
8035 // ( handle -- success? )
8036 UFWORD(FILES_CLOSE) {
8037   const int32_t fd = (int32_t)ufoPop();
8038   if (fd < 0) ufoFatal("invalid file handle in 'CLOSE'");
8039   ufoPushBool(close(fd) == 0);
8040 }
8041
8042 // FILES:TELL
8043 // ( handle -- ofs TRUE / FALSE )
8044 // `handle` cannot be 0.
8045 UFWORD(FILES_TELL) {
8046   const int32_t fd = (int32_t)ufoPop();
8047   if (fd < 0) ufoFatal("invalid file handle in 'TELL'");
8048   const off_t pos = lseek(fd, 0, SEEK_CUR);
8049   if (pos != (off_t)-1) {
8050     ufoPush((uint32_t)pos);
8051     ufoPushBool(1);
8052   } else {
8053     ufoPushBool(0);
8054   }
8055 }
8056
8057 // FILES:SEEK-EX
8058 // ( ofs whence handle -- TRUE / FALSE )
8059 // `handle` cannot be 0.
8060 UFWORD(FILES_SEEK_EX) {
8061   const int32_t fd = (int32_t)ufoPop();
8062   const uint32_t whence = ufoPop();
8063   const uint32_t ofs = ufoPop();
8064   if (fd < 0) ufoFatal("invalid file handle in 'SEEK-EX'");
8065   if (whence != (uint32_t)SEEK_SET &&
8066       whence != (uint32_t)SEEK_CUR &&
8067       whence != (uint32_t)SEEK_END) ufoFatal("invalid `whence` in 'SEEK-EX'");
8068   const off_t pos = lseek(fd, (off_t)ofs, (int)whence);
8069   ufoPushBool(pos != (off_t)-1);
8070 }
8071
8072 // FILES:SIZE
8073 // ( handle -- size TRUE / FALSE )
8074 // `handle` cannot be 0.
8075 UFWORD(FILES_SIZE) {
8076   const int32_t fd = (int32_t)ufoPop();
8077   if (fd < 0) ufoFatal("invalid file handle in 'SIZE'");
8078   const off_t origpos = lseek(fd, 0, SEEK_CUR);
8079   if (origpos == (off_t)-1) {
8080     ufoPushBool(0);
8081   } else {
8082     const off_t size = lseek(fd, 0, SEEK_END);
8083     if (size == (off_t)-1) {
8084       (void)lseek(origpos, 0, SEEK_SET);
8085       ufoPushBool(0);
8086     } else if (lseek(origpos, 0, SEEK_SET) == origpos) {
8087       ufoPush((uint32_t)size);
8088       ufoPushBool(1);
8089     } else {
8090       ufoPushBool(0);
8091     }
8092   }
8093 }
8094
8095 // FILES:READ
8096 // ( addr count handle -- rdsize TRUE / FALSE )
8097 // `handle` cannot be 0.
8098 UFWORD(FILES_READ) {
8099   const int32_t fd = (int32_t)ufoPop();
8100   if (fd < 0) ufoFatal("invalid file handle in 'READ'");
8101   uint32_t count = ufoPop();
8102   uint32_t addr = ufoPop();
8103   uint32_t done = 0;
8104   if (count != 0) {
8105     if ((count & 0x80000000U) != 0) ufoFatal("invalid number of bytes to read from file");
8106     while (count != done) {
8107       uint32_t rd = (uint32_t)sizeof(ufoFileIOBuffer);
8108       if (rd > count) rd = count;
8109       for (;;) {
8110         const ssize_t xres = read(fd, ufoFileIOBuffer, rd);
8111         if (xres >= 0) { rd = (uint32_t)xres; break; }
8112         if (errno == EINTR) continue;
8113         if (errno == EAGAIN || errno == EWOULDBLOCK) { rd = 0; break; }
8114         // error
8115         ufoPushBool(0);
8116         return;
8117       }
8118       if (rd == 0) break;
8119       done += rd;
8120       for (uint32_t f = 0; f != rd; f += 1u) {
8121         ufoImgPutU8(addr, ufoFileIOBuffer[f]);
8122         addr += 1u;
8123       }
8124     }
8125   }
8126   ufoPush(done);
8127   ufoPushBool(1);
8128 }
8129
8130 // FILES:READ-EXACT
8131 // ( addr count handle -- TRUE / FALSE )
8132 // `handle` cannot be 0.
8133 UFWORD(FILES_READ_EXACT) {
8134   const int32_t fd = (int32_t)ufoPop();
8135   if (fd < 0) ufoFatal("invalid file handle in 'READ-EXACT'");
8136   uint32_t count = ufoPop();
8137   uint32_t addr = ufoPop();
8138   if (count != 0) {
8139     if ((count & 0x80000000U) != 0) ufoFatal("invalid number of bytes to read from file");
8140     while (count != 0) {
8141       uint32_t rd = (uint32_t)sizeof(ufoFileIOBuffer);
8142       if (rd > count) rd = count;
8143       for (;;) {
8144         const ssize_t xres = read(fd, ufoFileIOBuffer, rd);
8145         if (xres >= 0) { rd = (uint32_t)xres; break; }
8146         if (errno == EINTR) continue;
8147         if (errno == EAGAIN || errno == EWOULDBLOCK) { rd = 0; break; }
8148         // error
8149         ufoPushBool(0);
8150         return;
8151       }
8152       if (rd == 0) { ufoPushBool(0); return; } // still error
8153       count -= rd;
8154       for (uint32_t f = 0; f != rd; f += 1u) {
8155         ufoImgPutU8(addr, ufoFileIOBuffer[f]);
8156         addr += 1u;
8157       }
8158     }
8159   }
8160   ufoPushBool(1);
8161 }
8162
8163 // FILES:WRITE
8164 // ( addr count handle -- TRUE / FALSE )
8165 // `handle` cannot be 0.
8166 UFWORD(FILES_WRITE) {
8167   const int32_t fd = (int32_t)ufoPop();
8168   if (fd < 0) ufoFatal("invalid file handle in 'WRITE'");
8169   uint32_t count = ufoPop();
8170   uint32_t addr = ufoPop();
8171   if (count != 0) {
8172     if ((count & 0x80000000U) != 0) ufoFatal("invalid number of bytes to write to file");
8173     while (count != 0) {
8174       uint32_t wr = (uint32_t)sizeof(ufoFileIOBuffer);
8175       if (wr > count) wr = count;
8176       for (uint32_t f = 0; f != wr; f += 1u) {
8177         ufoFileIOBuffer[f] = ufoImgGetU8(addr + f);
8178       }
8179       for (;;) {
8180         const ssize_t xres = write(fd, ufoFileIOBuffer, wr);
8181         if (xres >= 0) { wr = (uint32_t)xres; break; }
8182         if (errno == EINTR) continue;
8183         fprintf(stderr, "ERRNO: %d (fd=%d)\n", errno, fd);
8184         //if (errno == EAGAIN || errno == EWOULDBLOCK) { wr = 0; break; }
8185         // error
8186         ufoPushBool(0);
8187         return;
8188       }
8189       if (wr == 0) { ufoPushBool(1); return; } // still error
8190       count -= wr; addr += wr;
8191     }
8192   }
8193   ufoPushBool(1);
8194 }
8195
8196
8197 // ////////////////////////////////////////////////////////////////////////// //
8198 // states
8199 //
8200
8201 #ifdef UFO_MTASK_ALLOWED
8202 //==========================================================================
8203 //
8204 //  ufoNewState
8205 //
8206 //  create a new state, its execution will start from the given CFA.
8207 //  state is not automatically activated.
8208 //
8209 //==========================================================================
8210 static UfoState *ufoNewState (void) {
8211   // find free state id
8212   uint32_t fidx = 0;
8213   uint32_t bmp = ufoStateUsedBitmap[0];
8214   while (fidx != (uint32_t)(UFO_MAX_STATES/32) && bmp == ~(uint32_t)0) {
8215     fidx += 1u;
8216     bmp = ufoStateUsedBitmap[fidx];
8217   }
8218   if (fidx == (uint32_t)(UFO_MAX_STATES/32)) ufoFatal("too many execution states");
8219   //fprintf(stderr, "NST:000: fidx=%u; bmp=0x%08x\n", fidx, bmp);
8220   fidx *= 32u;
8221   while ((bmp & 0x01) != 0) { fidx += 1u; bmp >>= 1; }
8222   ufo_assert(fidx < UFO_MAX_STATES);
8223   ufo_assert((ufoStateUsedBitmap[fidx / 32u] & ((uint32_t)1 << (fidx & 0x1f))) == 0);
8224   ufo_assert(ufoStateMap[fidx] == NULL);
8225   UfoState *st = calloc(1, sizeof(UfoState));
8226   if (st == NULL) ufoFatal("out of memory for states");
8227   st->id = fidx + 1u;
8228   ufoStateMap[fidx] = st;
8229   ufoStateUsedBitmap[fidx / 32u] |= ((uint32_t)1 << (fidx & 0x1f));
8230   //fprintf(stderr, "NST: fidx=%u; 0x%08x\n", fidx, ufoStateUsedBitmap[fidx / 32u]);
8231   return st;
8232 }
8233
8234
8235 //==========================================================================
8236 //
8237 //  ufoFreeState
8238 //
8239 //  free all memory used for the state, remove it from state list.
8240 //  WARNING! never free current state!
8241 //
8242 //==========================================================================
8243 static void ufoFreeState (UfoState *st) {
8244   if (st != NULL) {
8245     if (st == ufoCurrState) ufoFatal("cannot free active state");
8246     if (ufoYieldedState == st) ufoYieldedState = NULL;
8247     if (ufoDebuggerState == st) ufoDebuggerState = NULL;
8248     const uint32_t fidx = st->id - 1u;
8249     //fprintf(stderr, "FST: fidx=%u; 0x%08x\n", fidx, ufoStateUsedBitmap[fidx / 32u]);
8250     ufo_assert(fidx < UFO_MAX_STATES);
8251     ufo_assert((ufoStateUsedBitmap[fidx / 32u] & (1u << (fidx & 0x1f))) != 0);
8252     ufo_assert(ufoStateMap[fidx] == st);
8253     // free default TIB handle
8254     UfoState *oldst = ufoCurrState;
8255     ufoCurrState = st;
8256     const uint32_t tib = ufoImgGetU32(ufoAddrDefTIB);
8257     if ((tib & UFO_ADDR_TEMP_BIT) != 0) {
8258       UfoHandle *tibh = ufoGetHandle(tib);
8259       if (tibh != NULL) ufoFreeHandle(tibh);
8260     }
8261     ufoCurrState = oldst;
8262     // free temp buffer
8263     #ifndef UFO_HUGE_IMAGES
8264     if (st->imageTemp != NULL) free(st->imageTemp);
8265     #endif
8266     free(st);
8267     ufoStateMap[fidx] = NULL;
8268     ufoStateUsedBitmap[fidx / 32u] &= ~((uint32_t)1 << (fidx & 0x1f));
8269   }
8270 }
8271
8272
8273 //==========================================================================
8274 //
8275 //  ufoFindState
8276 //
8277 //==========================================================================
8278 static UfoState *ufoFindState (uint32_t stid) {
8279   UfoState *res = NULL;
8280   if (stid >= 0 && stid <= UFO_MAX_STATES) {
8281     if (stid == 0) {
8282       // current
8283       ufo_assert(ufoCurrState != NULL);
8284       stid = ufoCurrState->id - 1u;
8285     } else {
8286       stid -= 1u;
8287     }
8288     res = ufoStateMap[stid];
8289     if (res != NULL) {
8290       ufo_assert((ufoStateUsedBitmap[stid / 32u] & (1u << (stid & 0x1f))) != 0);
8291       ufo_assert(res->id == stid + 1u);
8292     } else {
8293       ufo_assert((ufoStateUsedBitmap[stid / 32u] & (1u << (stid & 0x1f))) == 0);
8294     }
8295   }
8296   return res;
8297 }
8298
8299
8300 //==========================================================================
8301 //
8302 //  ufoSwitchToState
8303 //
8304 //==========================================================================
8305 static void ufoSwitchToState (UfoState *newst) {
8306   ufo_assert(newst != NULL);
8307   if (newst != ufoCurrState) {
8308     ufoCurrState = newst;
8309   }
8310 }
8311 #endif
8312
8313
8314 // ////////////////////////////////////////////////////////////////////////// //
8315 // initial dictionary definitions
8316 //
8317
8318 #undef UFWORD
8319
8320 #define UFWORD(name_)  do { \
8321   const uint32_t xcfa_ = ufoCFAsUsed; \
8322   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
8323   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
8324   ufoCFAsUsed += 1; \
8325   ufoDefineNative(""#name_, xcfa_, 0); \
8326 } while (0)
8327
8328 #define UFWORDX(strname_,name_)  do { \
8329   const uint32_t xcfa_ = ufoCFAsUsed; \
8330   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
8331   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
8332   ufoCFAsUsed += 1; \
8333   ufoDefineNative(strname_, xcfa_, 0); \
8334 } while (0)
8335
8336 #define UFWORD_IMM(name_)  do { \
8337   const uint32_t xcfa_ = ufoCFAsUsed; \
8338   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
8339   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
8340   ufoCFAsUsed += 1; \
8341   ufoDefineNative(""#name_, xcfa_, 1); \
8342 } while (0)
8343
8344 #define UFWORDX_IMM(strname_,name_)  do { \
8345   const uint32_t xcfa_ = ufoCFAsUsed; \
8346   ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
8347   ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
8348   ufoCFAsUsed += 1; \
8349   ufoDefineNative(strname_, xcfa_, 1); \
8350 } while (0)
8351
8352 #define UFC(name_)  ufoImgEmitU32_NoInline(ufoFindWordChecked(name_))
8353
8354
8355 //==========================================================================
8356 //
8357 //  ufoFindWordChecked
8358 //
8359 //==========================================================================
8360 UFO_DISABLE_INLINE uint32_t ufoFindWordChecked (const char *wname) {
8361   const uint32_t cfa = ufoFindWord(wname);
8362   if (cfa == 0) ufoFatal("word '%s' not found", wname);
8363   return cfa;
8364 }
8365
8366
8367 //==========================================================================
8368 //
8369 //  ufoGetForthVocId
8370 //
8371 //  get "FORTH" vocid
8372 //
8373 //==========================================================================
8374 uint32_t ufoGetForthVocId (void) {
8375   return ufoForthVocId;
8376 }
8377
8378
8379 //==========================================================================
8380 //
8381 //  ufoVocSetOnlyDefs
8382 //
8383 //==========================================================================
8384 void ufoVocSetOnlyDefs (uint32_t vocid) {
8385   ufoImgPutU32(ufoAddrCurrent, vocid);
8386   ufoImgPutU32(ufoAddrContext, vocid);
8387 }
8388
8389
8390 //==========================================================================
8391 //
8392 //  ufoCreateVoc
8393 //
8394 //  return voc PFA (vocid)
8395 //
8396 //==========================================================================
8397 uint32_t ufoCreateVoc (const char *wname, uint32_t parentvocid, uint32_t flags) {
8398   // create wordlist struct
8399   // typeid, used by Forth code (structs and such)
8400   ufoImgEmitU32(0); // typeid
8401   // vocid points here, to "LATEST-LFA"
8402   const uint32_t vocid = UFO_GET_DP();
8403   //fprintf(stderr, "NEW VOCID (%s): 0x%08x\n", wname, vocid);
8404   ufoImgEmitU32(0); // latest
8405   const uint32_t vlink = UFO_GET_DP();
8406   if ((vocid & UFO_ADDR_TEMP_BIT) == 0) {
8407     ufoImgEmitU32(ufoImgGetU32(ufoAddrVocLink)); // voclink
8408     ufoImgPutU32(ufoAddrVocLink, vlink); // update voclink
8409   } else {
8410     abort();
8411     ufoImgEmitU32(0);
8412   }
8413   ufoImgEmitU32(parentvocid); // parent
8414   const uint32_t hdraddr = UFO_GET_DP();
8415   ufoImgEmitU32(0); // word header
8416   // create empty hash table
8417   for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) ufoImgEmitU32(0);
8418   // update CONTEXT and CURRENT if this is the first wordlist ever
8419   if (ufoImgGetU32(ufoAddrContext) == 0) {
8420     ufoImgPutU32(ufoAddrContext, vocid);
8421   }
8422   if (ufoImgGetU32(ufoAddrCurrent) == 0) {
8423     ufoImgPutU32(ufoAddrCurrent, vocid);
8424   }
8425   // create word header
8426   if (wname != NULL && wname[0] != 0) {
8427     /*
8428     uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
8429     flags &=
8430       //UFW_FLAG_IMMEDIATE|
8431       //UFW_FLAG_SMUDGE|
8432       //UFW_FLAG_NORETURN|
8433       UFW_FLAG_HIDDEN|
8434       //UFW_FLAG_CBLOCK|
8435       //UFW_FLAG_VOCAB|
8436       //UFW_FLAG_SCOLON|
8437       UFW_FLAG_PROTECTED;
8438     flags |= UFW_FLAG_VOCAB;
8439     */
8440     flags &= 0xffffff00u;
8441     flags |= UFW_FLAG_VOCAB;
8442     ufoCreateWordHeader(wname, flags);
8443     const uint32_t cfa = UFO_GET_DP();
8444     ufoImgEmitCFA(ufoDoVocCFA); // cfa
8445     ufoImgEmitU32(vocid); // pfa
8446     // update vocab header pointer
8447     const uint32_t lfa = UFO_CFA_TO_LFA(cfa);
8448     ufoImgPutU32(hdraddr, UFO_LFA_TO_NFA(lfa));
8449     #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
8450     ufoDumpWordHeader(lfa);
8451     #endif
8452   }
8453   return vocid;
8454 }
8455
8456
8457 //==========================================================================
8458 //
8459 //  ufoSetLatestArgs
8460 //
8461 //==========================================================================
8462 static void ufoSetLatestArgs (uint32_t warg) {
8463   const uint32_t curr = ufoImgGetU32(ufoAddrCurrent);
8464   const uint32_t lfa = ufoImgGetU32(curr);
8465   const uint32_t nfa = UFO_LFA_TO_NFA(lfa);
8466   uint32_t flags = ufoImgGetU32(nfa);
8467   //fprintf(stderr, "OLD FLAGS: 0x%08x\n", flags);
8468   flags &= ~UFW_WARG_MASK;
8469   flags |= warg & UFW_WARG_MASK;
8470   //fprintf(stderr, "NEW FLAGS: 0x%08x\n", flags);
8471   ufoImgPutU32(nfa, flags);
8472   #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
8473   ufoDumpWordHeader(lfa);
8474   #endif
8475 }
8476
8477
8478 //==========================================================================
8479 //
8480 //  ufoDefine
8481 //
8482 //==========================================================================
8483 static void ufoDefineNative (const char *wname, uint32_t cfaidx, int immed) {
8484   cfaidx |= UFO_ADDR_CFA_BIT;
8485   uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
8486   flags &=
8487       //UFW_FLAG_IMMEDIATE|
8488       //UFW_FLAG_SMUDGE|
8489       //UFW_FLAG_NORETURN|
8490       UFW_FLAG_HIDDEN|
8491       //UFW_FLAG_CBLOCK|
8492       //UFW_FLAG_VOCAB|
8493       //UFW_FLAG_SCOLON|
8494       UFW_FLAG_PROTECTED;
8495   if (immed) flags |= UFW_FLAG_IMMEDIATE;
8496   ufoCreateWordHeader(wname, flags);
8497   ufoImgEmitCFA(cfaidx);
8498 }
8499
8500
8501 //==========================================================================
8502 //
8503 //  ufoDefineConstant
8504 //
8505 //==========================================================================
8506 static void ufoDefineConstant (const char *name, uint32_t value) {
8507   ufoDefineNative(name, ufoDoConstCFA, 0);
8508   ufoImgEmitU32(value);
8509 }
8510
8511
8512 //==========================================================================
8513 //
8514 //  ufoDefineUserVar
8515 //
8516 //==========================================================================
8517 static void ufoDefineUserVar (const char *name, uint32_t addr) {
8518   ufoDefineNative(name, ufoDoUserVariableCFA, 0);
8519   ufoImgEmitU32(addr);
8520 }
8521
8522
8523 //==========================================================================
8524 //
8525 //  ufoDefineVar
8526 //
8527 //==========================================================================
8528 static void ufoDefineVar (const char *name, uint32_t value) {
8529   ufoDefineNative(name, ufoDoVariableCFA, 0);
8530   ufoImgEmitU32(value);
8531 }
8532
8533
8534 //==========================================================================
8535 //
8536 //  ufoDefineDefer
8537 //
8538 //==========================================================================
8539 static void ufoDefineDefer (const char *name, uint32_t value) {
8540   ufoDefineNative(name, ufoDoDeferCFA, 0);
8541   ufoImgEmitU32(value);
8542 }
8543
8544
8545 //==========================================================================
8546 //
8547 //  ufoHiddenWords
8548 //
8549 //==========================================================================
8550 static void ufoHiddenWords (void) {
8551   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
8552   ufoImgPutU32(ufoAddrNewWordFlags, flags | UFW_FLAG_HIDDEN);
8553 }
8554
8555
8556 //==========================================================================
8557 //
8558 //  ufoPublicWords
8559 //
8560 //==========================================================================
8561 static void ufoPublicWords (void) {
8562   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
8563   ufoImgPutU32(ufoAddrNewWordFlags, flags & ~UFW_FLAG_HIDDEN);
8564 }
8565
8566
8567 //==========================================================================
8568 //
8569 //  ufoDefineForth
8570 //
8571 //==========================================================================
8572 /*
8573 static void ufoDefineForth (const char *name) {
8574   ufoDefineNative(name, ufoDoForthCFA, 0);
8575 }
8576 */
8577
8578
8579 //==========================================================================
8580 //
8581 //  ufoDefineForthImm
8582 //
8583 //==========================================================================
8584 /*
8585 static void ufoDefineForthImm (const char *name) {
8586   ufoDefineNative(name, ufoDoForthCFA, 1);
8587 }
8588 */
8589
8590
8591 //==========================================================================
8592 //
8593 //  ufoDefineForthHidden
8594 //
8595 //==========================================================================
8596 /*
8597 static void ufoDefineForthHidden (const char *name) {
8598   const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
8599   ufoImgPutU32(ufoAddrNewWordFlags, flags | UFW_FLAG_HIDDEN);
8600   ufoDefineNative(name, ufoDoForthCFA, 0);
8601   ufoImgPutU32(ufoAddrNewWordFlags, flags);
8602 }
8603 */
8604
8605
8606 //==========================================================================
8607 //
8608 //  ufoDefineSColonForth
8609 //
8610 //  create word suitable for scattered colon extension
8611 //
8612 //==========================================================================
8613 static void ufoDefineSColonForth (const char *name) {
8614   ufoDefineNative(name, ufoDoForthCFA, 0);
8615   // placeholder for scattered colon
8616   // it will compile two branches:
8617   // the first branch will jump to the first "..:" word (or over the two branches)
8618   // the second branch is never taken, and works as a pointer to the latest branch addr in the list
8619   // this way, each extension word will simply fix the last branch address, and update list tail
8620   // at the creation time, second branch points to the first branch
8621   UFC("FORTH:(BRANCH)");
8622   const uint32_t xjmp = UFO_GET_DP();
8623   ufoImgEmitU32(0);
8624   UFC("FORTH:(BRANCH)");
8625   #ifdef UFO_RELATIVE_BRANCH
8626   ufoImgEmitU32(xjmp - UFO_GET_DP()); // address of the fist branch dest
8627   ufoImgPutU32(xjmp, UFO_GET_DP() - xjmp); // jump over the jump
8628   #else
8629   ufoImgEmitU32(xjmp);
8630   ufoImgPutU32(xjmp, UFO_GET_DP());
8631   #endif
8632 }
8633
8634
8635 //==========================================================================
8636 //
8637 //  ufoDoneForth
8638 //
8639 //==========================================================================
8640 UFO_FORCE_INLINE void ufoDoneForth (void) {
8641   UFC("FORTH:(EXIT)");
8642 }
8643
8644
8645 //==========================================================================
8646 //
8647 //  ufoCompileStrLit
8648 //
8649 //  compile string literal, the same as QUOTE_IMM
8650 //
8651 //==========================================================================
8652 static void ufoCompileStrLitEx (const char *str, const uint32_t slen) {
8653   if (str == NULL) str = "";
8654   if (slen > 255) ufoFatal("string literal too long");
8655   UFC("FORTH:(LITSTR8)");
8656   ufoImgEmitU8((uint8_t)slen);
8657   for (size_t f = 0; f < slen; f += 1) {
8658     ufoImgEmitU8(((const unsigned char *)str)[f]);
8659   }
8660   ufoImgEmitU8(0);
8661   ufoImgEmitAlign();
8662 }
8663
8664
8665 //==========================================================================
8666 //
8667 //  ufoCompileStrLit
8668 //
8669 //==========================================================================
8670 /*
8671 static void ufoCompileStrLit (const char *str) {
8672   ufoCompileStrLitEx(str, (uint32_t)strlen(str));
8673 }
8674 */
8675
8676
8677 //==========================================================================
8678 //
8679 //  ufoCompileLit
8680 //
8681 //==========================================================================
8682 static void ufoCompileLit (uint32_t value) {
8683   UFC("FORTH:(LIT)");
8684   ufoImgEmitU32(value);
8685 }
8686
8687
8688 //==========================================================================
8689 //
8690 //  ufoCompileCFALit
8691 //
8692 //==========================================================================
8693 /*
8694 static void ufoCompileCFALit (const char *wname) {
8695   UFC("FORTH:(LITCFA)");
8696   const uint32_t cfa = ufoFindWordChecked(wname);
8697   ufoImgEmitU32(cfa);
8698 }
8699 */
8700
8701
8702 //==========================================================================
8703 //
8704 //  ufoXStrEquCI
8705 //
8706 //==========================================================================
8707 static int ufoXStrEquCI (const char *word, const char *text, uint32_t tlen) {
8708   while (tlen != 0 && *word) {
8709     if (toUpper(*word) != toUpper(*text)) return 0;
8710     word += 1u; text += 1u; tlen -= 1u;
8711   }
8712   return (tlen == 0 && *word == 0);
8713 }
8714
8715
8716 #define UFO_MAX_LABEL_NAME  (63)
8717 typedef struct UfoLabel_t {
8718   uint32_t hash;
8719   uint32_t namelen;
8720   char name[UFO_MAX_LABEL_NAME];
8721   uint32_t addr; // jump chain tail, or address
8722   uint32_t defined;
8723   uint32_t word; // is this a forward word definition?
8724   struct UfoLabel_t *next;
8725 } UfoLabel;
8726
8727 static UfoLabel *ufoLabels = NULL;
8728
8729
8730 //==========================================================================
8731 //
8732 //  ufoFindAddLabelEx
8733 //
8734 //==========================================================================
8735 static UfoLabel *ufoFindAddLabelEx (const char *name, uint32_t namelen, int allowAdd) {
8736   if (namelen == 0 || namelen > UFO_MAX_LABEL_NAME) ufoFatal("invalid label name");
8737   const uint32_t hash = joaatHashBufCI(name, namelen);
8738   UfoLabel *lbl = ufoLabels;
8739   while (lbl != NULL) {
8740     if (lbl->hash == hash && lbl->namelen == namelen) {
8741       int ok = 1;
8742       uint32_t sidx = 0;
8743       while (ok && sidx != namelen) {
8744         ok = (toUpper(name[sidx]) == toUpper(lbl->name[sidx]));
8745         sidx += 1;
8746       }
8747       if (ok) return lbl;
8748     }
8749     lbl = lbl->next;
8750   }
8751   if (allowAdd) {
8752     // create new label
8753     lbl = calloc(1, sizeof(UfoLabel));
8754     lbl->hash = hash;
8755     lbl->namelen = namelen;
8756     memcpy(lbl->name, name, namelen);
8757     lbl->name[namelen] = 0;
8758     lbl->next = ufoLabels;
8759     ufoLabels = lbl;
8760     return lbl;
8761   } else {
8762     return NULL;
8763   }
8764 }
8765
8766
8767 //==========================================================================
8768 //
8769 //  ufoFindAddLabel
8770 //
8771 //==========================================================================
8772 static UfoLabel *ufoFindAddLabel (const char *name, uint32_t namelen) {
8773   return ufoFindAddLabelEx(name, namelen, 1);
8774 }
8775
8776
8777 //==========================================================================
8778 //
8779 //  ufoFindLabel
8780 //
8781 //==========================================================================
8782 static UfoLabel *ufoFindLabel (const char *name, uint32_t namelen) {
8783   return ufoFindAddLabelEx(name, namelen, 0);
8784 }
8785
8786
8787 //==========================================================================
8788 //
8789 //  ufoTrySimpleNumber
8790 //
8791 //  only decimal and C-like hexes; with an optional sign
8792 //
8793 //==========================================================================
8794 static int ufoTrySimpleNumber (const char *text, uint32_t tlen, uint32_t *num) {
8795   int neg = 0;
8796
8797   if (tlen != 0 && *text == '+') { text += 1u; tlen -= 1u; }
8798   else if (tlen != 0 && *text == '-') { neg = 1; text += 1u; tlen -= 1u; }
8799
8800   int base = 10; // default base
8801   if (tlen > 2 && text[0] == '0' && toUpper(text[1]) == 'X') {
8802     // hex
8803     base = 16;
8804     text += 2u; tlen -= 2u;
8805   }
8806
8807   if (tlen == 0 || digitInBase(*text, base) < 0) return 0;
8808
8809   int wasDigit = 0;
8810   uint32_t n = 0;
8811   int dig;
8812   while (tlen != 0) {
8813     if (*text == '_') {
8814       if (!wasDigit) return 0;
8815       wasDigit = 0;
8816     } else {
8817       dig = digitInBase(*text, base);
8818       if (dig < 0) return 0;
8819       wasDigit = 1;
8820       n = n * (uint32_t)base + (uint32_t)dig;
8821     }
8822     text += 1u; tlen -= 1u;
8823   }
8824
8825   if (!wasDigit) return 0;
8826   if (neg) n = ~n + 1u;
8827   *num = n;
8828   return 1;
8829 }
8830
8831
8832 //==========================================================================
8833 //
8834 //  ufoEmitLabelChain
8835 //
8836 //==========================================================================
8837 static void ufoEmitLabelChain (UfoLabel *lbl) {
8838   ufo_assert(lbl != NULL);
8839   ufo_assert(lbl->defined == 0);
8840   const uint32_t here = UFO_GET_DP();
8841   ufoImgEmitU32(lbl->addr);
8842   lbl->addr = here;
8843 }
8844
8845
8846 #ifdef UFO_RELATIVE_BRANCH
8847 #define UFO_XCOMPILER_BRANCH_SET(addr_,dest_)  { \
8848   const uint32_t a = (addr_); \
8849   const uint32_t da = (dest_); \
8850   ufoImgPutU32(a, da - a); \
8851 } while (0)
8852 #else
8853 #define UFO_XCOMPILER_BRANCH_SET(addr_,dest_)  { \
8854   const uint32_t a = (addr_); \
8855   const uint32_t da = (dest_); \
8856   ufoImgPutU32(a, da); \
8857 } while (0)
8858 #endif
8859
8860
8861 //==========================================================================
8862 //
8863 //  ufoEmitLabelRefHere
8864 //
8865 //==========================================================================
8866 UFO_FORCE_INLINE void ufoEmitLabelRefHere (UfoLabel *lbl) {
8867   ufo_assert(lbl != NULL);
8868   ufo_assert(lbl->defined != 0);
8869   if (lbl->word) {
8870     ufoImgEmitU32(lbl->addr);
8871   } else {
8872     const uint32_t here = UFO_GET_DP();
8873     ufoImgEmitU32(0);
8874     UFO_XCOMPILER_BRANCH_SET(here, lbl->addr);
8875   }
8876 }
8877
8878
8879 //==========================================================================
8880 //
8881 //  ufoFixLabelChainHere
8882 //
8883 //==========================================================================
8884 static void ufoFixLabelChainHere (UfoLabel *lbl) {
8885   ufo_assert(lbl != NULL);
8886   ufo_assert(lbl->defined == 0);
8887   const uint32_t here = UFO_GET_DP();
8888   lbl->defined = 1;
8889   while (lbl->addr != 0) {
8890     const uint32_t aprev = ufoImgGetU32(lbl->addr);
8891     if (lbl->word) {
8892       ufoImgPutU32(lbl->addr, here);
8893     } else {
8894       UFO_XCOMPILER_BRANCH_SET(lbl->addr, here);
8895     }
8896     lbl->addr = aprev;
8897   }
8898   lbl->addr = here;
8899 }
8900
8901
8902 #define UFO_MII_WORD_X_COMPILE   (-5)
8903 #define UFO_MII_WORD_COMPILE_IMM (-4)
8904 #define UFO_MII_WORD_CFA_LIT     (-3)
8905 #define UFO_MII_WORD_COMPILE     (-2)
8906 #define UFO_MII_IN_WORD          (-1)
8907 #define UFO_MII_NO_WORD          (0)
8908 #define UFO_MII_WORD_NAME        (1)
8909 #define UFO_MII_WORD_NAME_IMM    (2)
8910 #define UFO_MII_WORD_NAME_HIDDEN (3)
8911
8912 static int ufoMinInterpState = UFO_MII_NO_WORD;
8913
8914
8915 //==========================================================================
8916 //
8917 //  ufoFinalLabelCheck
8918 //
8919 //==========================================================================
8920 static void ufoFinalLabelCheck (void) {
8921   int errorCount = 0;
8922   if (ufoMinInterpState != UFO_MII_NO_WORD) {
8923     ufoFatal("missing semicolon");
8924   }
8925   while (ufoLabels != NULL) {
8926     UfoLabel *lbl = ufoLabels; ufoLabels = lbl->next;
8927     if (!lbl->defined) {
8928       fprintf(stderr, "UFO ERROR: label '%s' is not defined!\n", lbl->name);
8929       errorCount += 1;
8930     }
8931     free(lbl);
8932   }
8933   if (errorCount != 0) {
8934     ufoFatal("%d undefined label%s", errorCount, (errorCount != 1 ? "s" : ""));
8935   }
8936 }
8937
8938
8939 //==========================================================================
8940 //
8941 //  ufoInterpretLine
8942 //
8943 //  this is so i could write Forth definitions more easily
8944 //
8945 //  labels:
8946 //    $name -- reference
8947 //    $name: -- definition
8948 //
8949 //==========================================================================
8950 UFO_DISABLE_INLINE void ufoInterpretLine (const char *line) {
8951   char wname[UFO_MAX_WORD_LENGTH];
8952   uint32_t wlen, num, cfa;
8953   UfoLabel *lbl;
8954   while (*line) {
8955     if (*(const unsigned char *)line <= 32) {
8956       line += 1;
8957     } else if (ufoMinInterpState == UFO_MII_WORD_CFA_LIT ||
8958                ufoMinInterpState == UFO_MII_WORD_COMPILE ||
8959                ufoMinInterpState == UFO_MII_WORD_COMPILE_IMM ||
8960                ufoMinInterpState == UFO_MII_WORD_X_COMPILE)
8961     {
8962       // "[']"/"COMPILE"/"[COMPILE]" argument
8963       wlen = 1;
8964       while (((const unsigned char *)line)[wlen] > 32) wlen += 1;
8965       if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
8966       memcpy(wname, line, wlen);
8967       wname[wlen] = 0;
8968       switch (ufoMinInterpState) {
8969         case UFO_MII_WORD_CFA_LIT: UFC("FORTH:(LITCFA)"); break;
8970         case UFO_MII_WORD_COMPILE: UFC("FORTH:(LITCFA)"); break;
8971         case UFO_MII_WORD_X_COMPILE: UFC("FORTH:(LITCFA)"); break;
8972         case UFO_MII_WORD_COMPILE_IMM: break;
8973         default: ufo_assert(0);
8974       }
8975       cfa = ufoFindWord(wname);
8976       if (cfa != 0) {
8977         ufoImgEmitU32(cfa);
8978       } else {
8979         // forward reference
8980         lbl = ufoFindAddLabel(line, wlen);
8981         if (lbl->defined || (lbl->word == 0 && lbl->addr)) {
8982           ufoFatal("unknown word: '%s'", wname);
8983         }
8984         lbl->word = 1;
8985         ufoEmitLabelChain(lbl);
8986       }
8987       switch (ufoMinInterpState) {
8988         case UFO_MII_WORD_CFA_LIT: break;
8989         case UFO_MII_WORD_COMPILE: UFC("FORTH:COMPILE,"); break;
8990         case UFO_MII_WORD_X_COMPILE: UFC("FORTH:,"); break;
8991         case UFO_MII_WORD_COMPILE_IMM: break;
8992         default: ufo_assert(0);
8993       }
8994       ufoMinInterpState = UFO_MII_IN_WORD;
8995       line += wlen;
8996     } else if (ufoMinInterpState > UFO_MII_NO_WORD) {
8997       // new word
8998       wlen = 1;
8999       while (((const unsigned char *)line)[wlen] > 32) wlen += 1;
9000       if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
9001       if (wlen > 2 && line[0] == ':' && line[wlen - 1u] == ':') ufoFatal("invalid word name");
9002       memcpy(wname, line, wlen);
9003       wname[wlen] = 0;
9004       const uint32_t oldFlags = ufoImgGetU32(ufoAddrNewWordFlags);
9005       if (ufoMinInterpState == UFO_MII_WORD_NAME_HIDDEN) {
9006         ufoImgPutU32(ufoAddrNewWordFlags, oldFlags | UFW_FLAG_HIDDEN);
9007       }
9008       ufoDefineNative(wname, ufoDoForthCFA, (ufoMinInterpState == UFO_MII_WORD_NAME_IMM));
9009       ufoImgPutU32(ufoAddrNewWordFlags, oldFlags);
9010       ufoMinInterpState = UFO_MII_IN_WORD;
9011       // check for forward references
9012       lbl = ufoFindLabel(line, wlen);
9013       if (lbl != NULL) {
9014         if (lbl->defined || !lbl->word) {
9015           ufoFatal("label/word conflict for '%.*s'", (unsigned)wlen, line);
9016         }
9017         ufoFixLabelChainHere(lbl);
9018       }
9019       line += wlen;
9020     } else if ((line[0] == ';' && line[1] == ';') ||
9021                (line[0] == '-' && line[1] == '-') ||
9022                (line[0] == '/' && line[1] == '/') ||
9023                (line[0] == '\\' && ((const unsigned char *)line)[1] <= 32))
9024     {
9025       ufoFatal("do not use single-line comments");
9026     } else if (line[0] == '(' && ((const unsigned char *)line)[1] <= 32) {
9027       while (*line && *line != ')') line += 1;
9028       if (*line == ')') line += 1;
9029     } else {
9030       // word
9031       wlen = 1;
9032       while (((const unsigned char *)line)[wlen] > 32) wlen += 1;
9033       if (wlen == 1 && (line[0] == '"' || line[0] == '`')) {
9034         // string literal
9035         const char qch = line[0];
9036         if (!line[1]) ufoFatal("unterminated string literal");
9037         // skip quote and space
9038         if (((const unsigned char *)line)[1] <= 32) line += 2u; else line += 1u;
9039         wlen = 0;
9040         while (line[wlen] && line[wlen] != qch) wlen += 1u;
9041         if (line[wlen] != qch) ufoFatal("unterminated string literal");
9042         ufoCompileStrLitEx(line, wlen);
9043         line += wlen + 1u; // skip final quote
9044       } else if (wlen == 1 && line[0] == ':') {
9045         // new word
9046         if (ufoMinInterpState != UFO_MII_NO_WORD) ufoFatal("unexpected colon");
9047         ufoMinInterpState = UFO_MII_WORD_NAME;
9048         line += wlen;
9049       } else if (wlen == 1 && line[0] == ';') {
9050         // end word
9051         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected semicolon");
9052         ufoImgEmitU32(ufoFindWordChecked("FORTH:(EXIT)"));
9053         ufoMinInterpState = UFO_MII_NO_WORD;
9054         line += wlen;
9055       } else if (wlen == 2 && line[0] == '!' && line[1] == ':') {
9056         // new immediate word
9057         if (ufoMinInterpState != UFO_MII_NO_WORD) ufoFatal("unexpected colon");
9058         ufoMinInterpState = UFO_MII_WORD_NAME_IMM;
9059         line += wlen;
9060       } else if (wlen == 2 && line[0] == '*' && line[1] == ':') {
9061         // new hidden word
9062         if (ufoMinInterpState != UFO_MII_NO_WORD) ufoFatal("unexpected colon");
9063         ufoMinInterpState = UFO_MII_WORD_NAME_HIDDEN;
9064         line += wlen;
9065       } else if (wlen == 3 && memcmp(line, "[']", 3) == 0) {
9066         // cfa literal
9067         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
9068         ufoMinInterpState = UFO_MII_WORD_CFA_LIT;
9069         line += wlen;
9070       } else if (wlen == 7 && ufoXStrEquCI("COMPILE", line, wlen)) {
9071         // "COMPILE"
9072         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
9073         ufoMinInterpState = UFO_MII_WORD_COMPILE;
9074         line += wlen;
9075       } else if (wlen == 9 && ufoXStrEquCI("X-COMPILE", line, wlen)) {
9076         // "COMPILE"
9077         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
9078         ufoMinInterpState = UFO_MII_WORD_X_COMPILE;
9079         line += wlen;
9080       } else if (wlen == 9 && ufoXStrEquCI("[COMPILE]", line, wlen)) {
9081         // "[COMPILE]"
9082         if (ufoMinInterpState != UFO_MII_IN_WORD) ufoFatal("unexpected immediate tick");
9083         ufoMinInterpState = UFO_MII_WORD_COMPILE_IMM;
9084         line += wlen;
9085       } else {
9086         // look for a word
9087         if (wlen >= UFO_MAX_WORD_LENGTH) ufoFatal("word name too long");
9088         memcpy(wname, line, wlen);
9089         wname[wlen] = 0;
9090         cfa = ufoFindWord(wname);
9091         if (cfa != 0) {
9092           // compile word
9093           ufoImgEmitU32(cfa);
9094         } else if (ufoTrySimpleNumber(line, wlen, &num)) {
9095           // compile numeric literal
9096           ufoCompileLit(num);
9097         } else {
9098           // unknown word, this may be a forward reference, or a label definition
9099           // label defintion starts with "$"
9100           // (there are no words starting with "$" in the initial image)
9101           if (line[0] == '$') {
9102             if (wlen == 1) ufoFatal("dollar what?");
9103             if (wlen > 2 && line[wlen - 1u] == ':') {
9104               // label definition
9105               lbl = ufoFindAddLabel(line, wlen - 1u);
9106               if (lbl->defined) ufoFatal("double label '%s' definition", lbl->name);
9107               if (lbl->word)  ufoFatal("double label '%s' word conflict", lbl->name);
9108               ufoFixLabelChainHere(lbl);
9109             } else {
9110               // label reference
9111               lbl = ufoFindAddLabel(line, wlen);
9112               if (lbl->defined) {
9113                 ufoEmitLabelRefHere(lbl);
9114               } else {
9115                 ufoEmitLabelChain(lbl);
9116               }
9117             }
9118           } else {
9119             // forward reference
9120             lbl = ufoFindAddLabel(line, wlen);
9121             if (lbl->defined || (lbl->word == 0 && lbl->addr)) {
9122               ufoFatal("unknown word: '%s'", wname);
9123             }
9124             lbl->word = 1;
9125             ufoEmitLabelChain(lbl);
9126           }
9127         }
9128         line += wlen;
9129       }
9130     }
9131   }
9132 }
9133
9134
9135 //==========================================================================
9136 //
9137 //  ufoReset
9138 //
9139 //==========================================================================
9140 UFO_DISABLE_INLINE void ufoReset (void) {
9141   #ifdef UFO_MTASK_ALLOWED
9142   if (ufoCurrState == NULL) ufoFatal("no active execution state");
9143   #endif
9144
9145   ufoSP = 0; ufoRP = 0;
9146   ufoLP = 0; ufoLBP = 0;
9147
9148   ufoInRunWord = 0;
9149
9150   ufoInBacktrace = 0;
9151
9152   // save TIB
9153   const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
9154   const uint32_t tibDef = ufoImgGetU32(ufoAddrDefTIB);
9155   #ifdef UFO_MTASK_ALLOWED
9156   ufoInitStateUserVars(ufoCurrState);
9157   #else
9158   ufoInitStateUserVars(&ufoCurrState);
9159   #endif
9160   // restore TIB
9161   ufoImgPutU32(ufoAddrTIBx, tib);
9162   ufoImgPutU32(ufoAddrDefTIB, tibDef);
9163   ufoImgPutU32(ufoAddrRedefineWarning, UFO_REDEF_WARN_NORMAL);
9164   ufoResetTib();
9165
9166   ufoImgPutU32(ufoAddrNewWordFlags, 0);
9167   ufoVocSetOnlyDefs(ufoForthVocId);
9168 }
9169
9170
9171 //==========================================================================
9172 //
9173 //  ufoDefineEmitType
9174 //
9175 //==========================================================================
9176 UFO_DISABLE_INLINE void ufoDefineEmitType (void) {
9177   // EMIT
9178   // ( ch -- )
9179   ufoInterpretLine(": EMIT  ( ch -- )  (NORM-EMIT-CHAR) (EMIT) ;");
9180
9181   // XEMIT
9182   // ( ch -- )
9183   ufoInterpretLine(": XEMIT  ( ch -- )  (NORM-XEMIT-CHAR) (EMIT) ;");
9184
9185   // CR
9186   // ( -- )
9187   ufoInterpretLine(": CR  ( -- )  NL (EMIT) ;");
9188
9189   // ENDCR
9190   // ( -- )
9191   ufoInterpretLine(
9192     ": ENDCR  ( -- ) "
9193     "  LASTCR? FORTH:(TBRANCH) $endcr-exit CR "
9194     "$endcr-exit: "
9195     ";");
9196   //ufoDecompileWord(ufoFindWordChecked("ENDCR"));
9197
9198   // SPACE
9199   // ( -- )
9200   ufoInterpretLine(": SPACE  ( -- )  BL (EMIT) ;");
9201
9202   // SPACES
9203   // ( count -- )
9204   ufoInterpretLine(
9205     ": SPACES  ( count -- ) "
9206     "$spaces-again: "
9207     "    DUP 0> FORTH:(0BRANCH) $spaces-exit "
9208     "    SPACE 1- "
9209     "    FORTH:(BRANCH) $spaces-again "
9210     "$spaces-exit: "
9211     "  DROP "
9212     ";");
9213
9214   // (TYPE)
9215   // ( addr count -- )
9216   ufoInterpretLine(
9217     ": (TYPE)  ( addr count -- ) "
9218     "  A>R SWAP >A "
9219     "$par-type-again: "
9220     "    DUP 0> FORTH:(0BRANCH) $par-type-exit "
9221     "    C@A (EMIT) +1>A "
9222     "    1- "
9223     "    FORTH:(BRANCH) $par-type-again "
9224     "$par-type-exit: "
9225     "  DROP R>A "
9226     ";");
9227
9228   // TYPE
9229   // ( addr count -- )
9230   ufoInterpretLine(
9231     ": TYPE  ( addr count -- ) "
9232     "  A>R SWAP >A "
9233     "$type-again: "
9234     "    DUP 0> FORTH:(0BRANCH) $type-exit "
9235     "    C@A EMIT +1>A "
9236     "    1- "
9237     "    FORTH:(BRANCH) $type-again "
9238     "$type-exit: "
9239     "  DROP R>A "
9240     ";");
9241
9242   // XTYPE
9243   // ( addr count -- )
9244   ufoInterpretLine(
9245     ": XTYPE  ( addr count -- ) "
9246     "  A>R SWAP >A "
9247     "$xtype-again: "
9248     "    DUP 0> FORTH:(0BRANCH) $xtype-exit "
9249     "    C@A XEMIT +1>A "
9250     "    1- "
9251     "    FORTH:(BRANCH) $xtype-again "
9252     "$xtype-exit: "
9253     "  DROP R>A "
9254     ";");
9255
9256   // STRLITERAL
9257   // ( C:addr count -- )  ( E: -- addr count )
9258   ufoInterpretLine(
9259     ": STRLITERAL  ( C:addr count -- )  ( E: -- addr count ) "
9260     "  DUP 255 U> ` string literal too long` ?ERROR "
9261     "  COMPILER:EXEC? FORTH:(TBRANCH) $strlit-exit "
9262     "  HERE >R ( addr count | here ) "
9263     "  ['] FORTH:(LITSTR8) COMPILE, "
9264     "  A>R SWAP >A "
9265     "  ( compile length ) "
9266     "  DUP C, "
9267     "  ( compile chars ) "
9268     "$strlit-loop: "
9269     "    DUP 0<> FORTH:(0BRANCH) $strlit-loop-exit "
9270     "    C@A C, +1>A  1- "
9271     "  FORTH:(BRANCH) $strlit-loop "
9272     "$strlit-loop-exit: "
9273     "  R>A "
9274     "  ( final 0: our counter is 0 here, so use it ) "
9275     "  C, ALIGN-HERE "
9276     "  R> COMPILER:(AFTER-COMPILE-WORD) "
9277     "$strlit-exit: "
9278     ";");
9279
9280   // quote
9281   // ( -- addr count )
9282   ufoInterpretLine(
9283     "!: \"  ( -- addr count ) "
9284     "  34 PARSE ` string literal expected` ?NOT-ERROR "
9285     "  COMPILER:(UNESCAPE) STRLITERAL "
9286     ";");
9287 }
9288
9289
9290 //==========================================================================
9291 //
9292 //  ufoDefineInterpret
9293 //
9294 //  define "INTERPRET" in Forth
9295 //
9296 //==========================================================================
9297 UFO_DISABLE_INLINE void ufoDefineInterpret (void) {
9298   UFWORDX("(UFO-INTERPRET-FINISHED-ACTION)", UFO_INTERPRET_FINISHED_ACTION);
9299
9300   // return "stop flag"
9301   ufoInterpretLine(
9302     "*: (UFO-INTERPRET-NEXT-LINE)  ( -- continue? ) "
9303     "  COMPILER:COMP? FORTH:(TBRANCH) $ipn_incomp "
9304     "    ( interpreter allowed to cross include boundary ) "
9305     "    REFILL FORTH:(BRANCH) $ipn_done "
9306     "$ipn_incomp: "
9307     "    ( compiler is not allowed to cross include boundary ) "
9308     "    REFILL-NOCROSS ` compiler cannot cross file boundaries` ?NOT-ERROR "
9309     "    TRUE "
9310     "$ipn_done: "
9311     ";");
9312
9313   ufoInterpNextLineCFA = ufoFindWordChecked("FORTH:(UFO-INTERPRET-NEXT-LINE)");
9314   ufoInterpretLine("*: (INTERPRET-NEXT-LINE)  (USER-INTERPRET-NEXT-LINE) @ EXECUTE-TAIL ;");
9315
9316   // skip comments, parse name, refilling lines if necessary
9317   // returning FALSE as counter means: "no addr, exit INTERPRET"
9318   ufoInterpretLine(
9319     "*: (INTERPRET-PARSE-NAME)  ( -- addr count / FALSE ) "
9320     "$label_ipn_again: "
9321     "  TRUE (PARSE-SKIP-COMMENTS) PARSE-NAME "
9322     "  DUP FORTH:(TBRANCH) $label_ipn_exit_fwd "
9323     "  2DROP (INTERPRET-NEXT-LINE) "
9324     "  FORTH:(TBRANCH) $label_ipn_again "
9325     "  FALSE "
9326     "$label_ipn_exit_fwd: "
9327     ";");
9328   //ufoDecompileWord(ufoFindWordChecked("(INTERPRET-PARSE-NAME)"));
9329
9330   ufoInterpretLine(
9331     ": INTERPRET "
9332     "$interp-again: "
9333     "  FORTH:(INTERPRET-PARSE-NAME) ( addr count / FALSE )"
9334     "  ?DUP FORTH:(0BRANCH) $interp-done "
9335     "  ( try defered checker ) "
9336     "  ( addr count FALSE -- addr count FALSE / TRUE ) "
9337     "  FALSE (INTERPRET-CHECK-WORD) FORTH:(TBRANCH) $interp-again "
9338     "  2DUP FIND-WORD  ( addr count cfa TRUE / addr count FALSE ) "
9339     "  FORTH:(0BRANCH) $interp-try-number "
9340     "  ( word found ) "
9341     "  NROT 2DROP  ( drop word string ) "
9342     "  COMPILER:EXEC? FORTH:(TBRANCH) $interp-exec "
9343     "  ( compiling; check immediate bit ) "
9344     "  DUP CFA->NFA @ COMPILER:(WFLAG-IMMEDIATE) AND FORTH:(TBRANCH) $interp-exec "
9345     "  ( compile it ) "
9346     "  FORTH:COMPILE, FORTH:(BRANCH) $interp-again "
9347     "  ( execute it ) "
9348     "$interp-exec: "
9349     "  EXECUTE FORTH:(BRANCH) $interp-again "
9350     "  ( not a word, try a number ) "
9351     "$interp-try-number: "
9352     "  2DUP TRUE BASE @ (BASED-NUMBER)  ( addr count allowsign? base -- num TRUE / FALSE ) "
9353     "  FORTH:(0BRANCH) $interp-number-error "
9354     "  ( number ) "
9355     "  NROT 2DROP  ( drop word string ) "
9356     "  LITERAL FORTH:(BRANCH) $interp-again "
9357     "  ( error ) "
9358     "$interp-number-error: "
9359     "  ( addr count FALSE -- addr count FALSE / TRUE ) "
9360     "  FALSE (INTERPRET-WORD-NOT-FOUND) FORTH:(TBRANCH) $interp-again "
9361     "  (INTERPRET-WORD-NOT-FOUND-POST) "
9362     "  ENDCR SPACE XTYPE `  -- wut?` TYPE CR "
9363     "  ` unknown word` ERROR "
9364     "$interp-done: "
9365     ";");
9366   //ufoDecompileWord(ufoFindWordChecked("INTERPRET"));
9367 }
9368
9369
9370 //==========================================================================
9371 //
9372 //  ufoInitBaseDict
9373 //
9374 //==========================================================================
9375 UFO_DISABLE_INLINE void ufoInitBaseDict (void) {
9376   uint32_t imgAddr = 0;
9377
9378   // reserve 32 bytes for nothing
9379   for (uint32_t f = 0; f < 32; f += 1) {
9380     ufoImgPutU8(imgAddr, 0);
9381     imgAddr += 1;
9382   }
9383   // align
9384   while ((imgAddr & 3) != 0) {
9385     ufoImgPutU8(imgAddr, 0);
9386     imgAddr += 1;
9387   }
9388
9389   // DP
9390   ufoAddrDP = imgAddr;
9391   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
9392
9393   // (LATEST-XFA)
9394   ufoAddrLastXFA = imgAddr;
9395   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
9396
9397   // (VOC-LINK)
9398   ufoAddrVocLink = imgAddr;
9399   ufoImgPutU32(imgAddr, 0); imgAddr += 4u;
9400
9401   // (NEW-WORD-FLAGS)
9402   ufoAddrNewWordFlags = imgAddr;
9403   ufoImgPutU32(imgAddr, UFW_FLAG_PROTECTED); imgAddr += 4u;
9404
9405   // WORD-REDEFINE-WARN-MODE
9406   ufoAddrRedefineWarning = imgAddr;
9407   ufoImgPutU32(imgAddr, UFO_REDEF_WARN_NORMAL); imgAddr += 4u;
9408
9409   // setup (DP) and (DP-TEMP)
9410   ufoImgPutU32(ufoAddrDP, imgAddr);
9411   ufoImgPutU32(ufoAddrDPTemp, UFO_DPTEMP_BASE_ADDR);
9412   ufoImgPutU32(ufoAddrHereDP, ufoAddrDP);
9413
9414   #if 0
9415   fprintf(stderr, "INITIAL HERE: 0x%08x (0x%08x)\n", imgAddr, UFO_GET_DP());
9416   #endif
9417 }
9418
9419
9420 //==========================================================================
9421 //
9422 //  ufoInitStateUserVars
9423 //
9424 //==========================================================================
9425 static void ufoInitStateUserVars (UfoState *st) {
9426   ufo_assert(st != NULL);
9427   #ifndef UFO_HUGE_IMAGES
9428   if (st->imageTempSize < 8192u) {
9429     uint32_t *itmp = realloc(st->imageTemp, 8192);
9430     if (itmp == NULL) ufoFatal("out of memory for state user area");
9431     st->imageTemp = itmp;
9432     memset((uint8_t *)st->imageTemp + st->imageTempSize, 0, 8192u - st->imageTempSize);
9433     st->imageTempSize = 8192;
9434   }
9435   #endif
9436   st->imageTemp[(ufoAddrBASE & UFO_ADDR_TEMP_MASK) / 4u] = 10;
9437   st->imageTemp[(ufoAddrSTATE & UFO_ADDR_TEMP_MASK) / 4u] = 0;
9438   st->imageTemp[(ufoAddrUserVarUsed & UFO_ADDR_TEMP_MASK) / 4u] = ufoAddrUserVarUsed;
9439   st->imageTemp[(ufoAddrDefTIB & UFO_ADDR_TEMP_MASK) / 4u] = UFO_DEF_TIB_ADDR;
9440   st->imageTemp[(ufoAddrTIBx & UFO_ADDR_TEMP_MASK) / 4u] = UFO_DEF_TIB_ADDR;
9441   st->imageTemp[(ufoAddrINx & UFO_ADDR_TEMP_MASK) / 4u] = 0;
9442   st->imageTemp[(ufoAddrContext & UFO_ADDR_TEMP_MASK) / 4u] = ufoForthVocId;
9443   st->imageTemp[(ufoAddrCurrent & UFO_ADDR_TEMP_MASK) / 4u] = ufoForthVocId;
9444   st->imageTemp[(ufoAddrSelf & UFO_ADDR_TEMP_MASK) / 4u] = 0;
9445   st->imageTemp[(ufoAddrInterNextLine & UFO_ADDR_TEMP_MASK) / 4u] = ufoInterpNextLineCFA;
9446   st->imageTemp[(ufoAddrEP & UFO_ADDR_TEMP_MASK) / 4u] = 0;
9447   st->imageTemp[(ufoAddrDPTemp & UFO_ADDR_TEMP_MASK) / 4u] = UFO_DPTEMP_BASE_ADDR;
9448   st->imageTemp[(ufoAddrHereDP & UFO_ADDR_TEMP_MASK) / 4u] = ufoAddrDP;
9449
9450   // init other things, because this procedure is used in `ufoReset()` too
9451   st->SP = 0; st->RP = 0; st->regA = 0;
9452   st->LP = 0; st->LBP = 0;
9453   st->VSP = 0;
9454 }
9455
9456
9457 //==========================================================================
9458 //
9459 //  ufoInitBasicWords
9460 //
9461 //==========================================================================
9462 UFO_DISABLE_INLINE void ufoInitBasicWords (void) {
9463   ufoDefineConstant("FALSE", 0);
9464   ufoDefineConstant("TRUE", ufoTrueValue);
9465
9466   ufoDefineConstant("BL", 32);
9467   ufoDefineConstant("NL", 10);
9468
9469   UFWORDX("NOOP", NOOP);
9470   UFWORDX("(NOTIMPL)", PAR_NOTIMPL);
9471
9472   // user variables
9473   ufoDefineUserVar("BASE", ufoAddrBASE);
9474   ufoDefineUserVar("TIB", ufoAddrTIBx);
9475   ufoDefineUserVar(">IN", ufoAddrINx);
9476   ufoDefineUserVar("(STD-TIB-ADDR)", ufoAddrDefTIB);
9477   ufoDefineUserVar("(USER-VAR-USED)", ufoAddrUserVarUsed);
9478   ufoDefineConstant("(USER-VAR-ADDR)", UFO_ADDR_TEMP_BIT);
9479   ufoDefineConstant("(USER-VAR-SIZE)", UFO_USER_AREA_SIZE);
9480   ufoDefineConstant("(USER-TIB)", UFO_DEF_TIB_ADDR);
9481   ufoDefineConstant("(USER-TIB-SIZE)", UFO_ADDR_HANDLE_OFS_MASK);
9482
9483   ufoDefineUserVar("STATE", ufoAddrSTATE);
9484   ufoDefineConstant("CONTEXT", ufoAddrContext);
9485   ufoDefineConstant("CURRENT", ufoAddrCurrent);
9486   ufoDefineConstant("(SELF)", ufoAddrSelf); // used in OOP implementations
9487   ufoDefineConstant("(USER-INTERPRET-NEXT-LINE)", ufoAddrInterNextLine);
9488   ufoDefineConstant("(EXC-FRAME-PTR)", ufoAddrEP);
9489
9490   ufoHiddenWords();
9491   ufoDefineConstant("(LATEST-XFA)", ufoAddrLastXFA);
9492   ufoDefineConstant("(VOC-LINK)", ufoAddrVocLink);
9493   ufoDefineConstant("(NEW-WORD-FLAGS)", ufoAddrNewWordFlags);
9494   ufoDefineConstant("(ADDR-TEMP-BIT)", UFO_ADDR_TEMP_BIT);
9495   ufoDefineConstant("(ADDR-CFA-BIT)", UFO_ADDR_CFA_BIT);
9496   ufoDefineConstant("(ADDR-HANDLE-BIT)", UFO_ADDR_HANDLE_BIT);
9497   ufoDefineConstant("(MAX-HANDLE-OFS)", UFO_ADDR_HANDLE_OFS_MASK);
9498   ufoDefineConstant("(DP-TEMP-BASE-ADDR))", UFO_DPTEMP_BASE_ADDR);
9499
9500   ufoDefineConstant("(PAD-ADDR)", UFO_PAD_ADDR);
9501   ufoDefineConstant("(#BUF)", UFO_NBUF_ADDR + 4u); // reserve room for counter
9502   ufoDefineConstant("(#BUF-SIZE)", UFO_NBUF_SIZE - 8u);
9503
9504   ufoDefineConstant("(DP-MAIN)", ufoAddrDP);
9505   ufoDefineConstant("(DP-TEMP)", ufoAddrDPTemp); // in user vars
9506   ufoDefineConstant("(DP-HERE)", ufoAddrHereDP); // in user vars
9507   ufoPublicWords();
9508
9509   //UFWORDX("(UFO-BUCKET-STATS)", PAR_UFO_BUCKET_STATS);
9510   UFWORDX("SP0!", SP0_STORE);
9511   UFWORDX("RP0!", RP0_STORE);
9512
9513   UFWORDX("(SELF@)", PAR_SELF_LOAD);
9514   UFWORDX("(SELF!)", PAR_SELF_STORE);
9515
9516   UFWORDX("PAD", PAD);
9517   UFWORDX("HERE", HERE);
9518   UFWORDX("ALIGN-HERE", ALIGN_HERE);
9519
9520   UFWORDX("@", PEEK);
9521   UFWORDX("C@", CPEEK);
9522   UFWORDX("W@", WPEEK);
9523
9524   UFWORDX("!", POKE);
9525   UFWORDX("C!", CPOKE);
9526   UFWORDX("W!", WPOKE);
9527
9528   UFWORDX("(DIRECT:@)", DIRECT_PEEK); ufoSetLatestArgs(UFW_WARG_PFA);
9529   UFWORDX("(DIRECT:!)", DIRECT_POKE); ufoSetLatestArgs(UFW_WARG_PFA);
9530   UFWORDX("(DIRECT:0:!)", DIRECT_POKE0); ufoSetLatestArgs(UFW_WARG_PFA);
9531   UFWORDX("(DIRECT:1:!)", DIRECT_POKE1); ufoSetLatestArgs(UFW_WARG_PFA);
9532   UFWORDX("(DIRECT:-1:!)", DIRECT_POKEM1); ufoSetLatestArgs(UFW_WARG_PFA);
9533   UFWORDX("(DIRECT:+!)", DIRECT_ADD_POKE); ufoSetLatestArgs(UFW_WARG_PFA);
9534   UFWORDX("(DIRECT:-!)", DIRECT_SUB_POKE); ufoSetLatestArgs(UFW_WARG_PFA);
9535   UFWORDX("(DIRECT:+:@)", DIRECT_OFS_PEEK); ufoSetLatestArgs(UFW_WARG_LIT);
9536   UFWORDX("(DIRECT:+:!)", DIRECT_OFS_POKE); ufoSetLatestArgs(UFW_WARG_LIT);
9537   UFWORDX("(DIRECT:1+!)", DIRECT_POKE_INC1); ufoSetLatestArgs(UFW_WARG_LIT);
9538   UFWORDX("(DIRECT:2+!)", DIRECT_POKE_INC2); ufoSetLatestArgs(UFW_WARG_LIT);
9539   UFWORDX("(DIRECT:4+!)", DIRECT_POKE_INC4); ufoSetLatestArgs(UFW_WARG_LIT);
9540   UFWORDX("(DIRECT:8+!)", DIRECT_POKE_INC8); ufoSetLatestArgs(UFW_WARG_LIT);
9541   UFWORDX("(DIRECT:1-!)", DIRECT_POKE_DEC1); ufoSetLatestArgs(UFW_WARG_LIT);
9542   UFWORDX("(DIRECT:2-!)", DIRECT_POKE_DEC2); ufoSetLatestArgs(UFW_WARG_LIT);
9543   UFWORDX("(DIRECT:4-!)", DIRECT_POKE_DEC4); ufoSetLatestArgs(UFW_WARG_LIT);
9544   UFWORDX("(DIRECT:8-!)", DIRECT_POKE_DEC8); ufoSetLatestArgs(UFW_WARG_LIT);
9545
9546   UFWORDX("(LIT-AND)", LIT_AND); ufoSetLatestArgs(UFW_WARG_LIT);
9547   UFWORDX("(LIT-~AND)", LIT_NAND); ufoSetLatestArgs(UFW_WARG_LIT);
9548   UFWORDX("(LIT-OR)", LIT_OR); ufoSetLatestArgs(UFW_WARG_LIT);
9549   UFWORDX("(LIT-XOR)", LIT_XOR); ufoSetLatestArgs(UFW_WARG_LIT);
9550
9551   UFWORDX("0!", POKE_0);
9552   UFWORDX("1!", POKE_1);
9553   UFWORDX("1+!", POKE_INC_1);
9554   UFWORDX("1-!", POKE_DEC_1);
9555   UFWORDX("+!", POKE_INC);
9556   UFWORDX("-!", POKE_DEC);
9557
9558   UFWORDX("SWAP!", SWAP_POKE);
9559   UFWORDX("SWAP-C!", SWAP_CPOKE);
9560   UFWORDX("SWAP-W!", SWAP_WPOKE);
9561   UFWORDX("OR!", OR_POKE);
9562   UFWORDX("OR-C!", OR_CPOKE);
9563   UFWORDX("OR-W!", OR_WPOKE);
9564   UFWORDX("XOR!", XOR_POKE);
9565   UFWORDX("XOR-C!", XOR_CPOKE);
9566   UFWORDX("XOR-W!", XOR_WPOKE);
9567   UFWORDX("~AND!", NAND_POKE);
9568   UFWORDX("~AND-C!", NAND_CPOKE);
9569   UFWORDX("~AND-W!", NAND_WPOKE);
9570
9571   UFWORDX("COUNT", COUNT);
9572   UFWORDX("BCOUNT", BCOUNT);
9573   UFWORDX("ID-COUNT", ID_COUNT);
9574
9575   UFWORDX(",", COMMA);
9576   UFWORDX("C,", CCOMMA);
9577   UFWORDX("W,", WCOMMA);
9578
9579   UFWORDX("A>", REGA_LOAD);
9580   UFWORDX(">A", REGA_STORE);
9581   UFWORDX("A-SWAP", REGA_SWAP);
9582   UFWORDX("+1>A", REGA_INC);
9583   UFWORDX("+2>A", REGA_INC_WORD);
9584   UFWORDX("+4>A", REGA_INC_CELL);
9585   UFWORDX("-1>A", REGA_DEC);
9586   UFWORDX("-2>A", REGA_DEC_WORD);
9587   UFWORDX("-4>A", REGA_DEC_CELL);
9588   UFWORDX("A>R", REGA_TO_R);
9589   UFWORDX("R>A", R_TO_REGA);
9590
9591   UFWORDX("@A", PEEK_REGA);
9592   UFWORDX("C@A", CPEEK_REGA);
9593   UFWORDX("W@A", WPEEK_REGA);
9594
9595   UFWORDX("!A", POKE_REGA);
9596   UFWORDX("C!A", CPOKE_REGA);
9597   UFWORDX("W!A", WPOKE_REGA);
9598
9599   UFWORDX("@A+", PEEK_REGA_IDX);
9600   UFWORDX("C@A+", CPEEK_REGA_IDX);
9601   UFWORDX("W@A+", WPEEK_REGA_IDX);
9602
9603   UFWORDX("!A+", POKE_REGA_IDX);
9604   UFWORDX("C!A+", CPOKE_REGA_IDX);
9605   UFWORDX("W!A+", WPOKE_REGA_IDX);
9606
9607   UFWORDX("C!+1>A", CPOKE_REGA_INC1);
9608   UFWORDX("W!+2>A", WPOKE_REGA_INC2);
9609   UFWORDX("!+4>A", POKE_REGA_INC4);
9610   UFWORDX("C@+1>A", CPEEK_REGA_INC1);
9611   UFWORDX("W@+2>A", WPEEK_REGA_INC2);
9612   UFWORDX("@+4>A", PEEK_REGA_INC4);
9613
9614   ufoHiddenWords();
9615   UFWORDX("(LIT)", PAR_LIT); ufoSetLatestArgs(UFW_WARG_LIT);
9616   UFWORDX("(LITCFA)", PAR_LITCFA); ufoSetLatestArgs(UFW_WARG_CFA);
9617   UFWORDX("(LITPFA)", PAR_LITPFA); ufoSetLatestArgs(UFW_WARG_PFA);
9618   UFWORDX("(LITVOCID)", PAR_LITVOCID); ufoSetLatestArgs(UFW_WARG_VOCID);
9619   UFWORDX("(LITSTR8)", PAR_LITSTR8); ufoSetLatestArgs(UFW_WARG_C1STRZ);
9620   UFWORDX("(EXIT)", PAR_EXIT);
9621
9622   ufoLitStr8CFA = ufoFindWordChecked("FORTH:(LITSTR8)");
9623
9624   UFWORDX("(L-ENTER)", PAR_LENTER); ufoSetLatestArgs(UFW_WARG_LIT);
9625   UFWORDX("(L-LEAVE)", PAR_LLEAVE);
9626   UFWORDX("(LOCAL@)", PAR_LOCAL_LOAD);
9627   UFWORDX("(LOCAL!)", PAR_LOCAL_STORE);
9628
9629   UFWORDX("(BRANCH)", PAR_BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
9630   UFWORDX("(TBRANCH)", PAR_TBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
9631   UFWORDX("(0BRANCH)", PAR_0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
9632   UFWORDX("(+0BRANCH)", PAR_P0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
9633   UFWORDX("(+BRANCH)", PAR_PBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
9634   UFWORDX("(-0BRANCH)", PAR_M0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
9635   UFWORDX("(-BRANCH)", PAR_MBRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
9636   UFWORDX("(DATASKIP)", PAR_DATASKIP); ufoSetLatestArgs(UFW_WARG_DATASKIP);
9637   UFWORDX("(OR-BRANCH)", PAR_OR_BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
9638   UFWORDX("(AND-BRANCH)", PAR_AND_BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
9639   UFWORDX("(?DUP-0BRANCH)", PAR_QDUP_0BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
9640   UFWORDX("(CASE-BRANCH)", PAR_CASE_BRANCH); ufoSetLatestArgs(UFW_WARG_BRANCH);
9641   ufoPublicWords();
9642 }
9643
9644
9645 //==========================================================================
9646 //
9647 //  ufoInitMoreWords
9648 //
9649 //==========================================================================
9650 UFO_DISABLE_INLINE void ufoInitMoreWords (void) {
9651   UFWORDX("CFA->DOES-CFA", CFA2DOESCFA);
9652   UFWORDX("CFA->PFA", CFA2PFA);
9653   UFWORDX("CFA->NFA", CFA2NFA);
9654   UFWORDX("CFA->LFA", CFA2LFA);
9655   UFWORDX("CFA->WEND", CFA2WEND);
9656
9657   UFWORDX("PFA->CFA", PFA2CFA);
9658   UFWORDX("PFA->NFA", PFA2NFA);
9659
9660   UFWORDX("NFA->CFA", NFA2CFA);
9661   UFWORDX("NFA->PFA", NFA2PFA);
9662   UFWORDX("NFA->LFA", NFA2LFA);
9663
9664   UFWORDX("LFA->CFA", LFA2CFA);
9665   UFWORDX("LFA->PFA", LFA2PFA);
9666   UFWORDX("LFA->BFA", LFA2BFA);
9667   UFWORDX("LFA->XFA", LFA2XFA);
9668   UFWORDX("LFA->YFA", LFA2YFA);
9669   UFWORDX("LFA->NFA", LFA2NFA);
9670
9671   UFWORDX("(BASED-NUMBER)", PAR_BASED_NUMBER);
9672   UFWORDX("FIND-WORD", FIND_WORD);
9673   UFWORDX("(FIND-WORD-IN-VOC)", PAR_FIND_WORD_IN_VOC);
9674   UFWORDX("(FIND-WORD-IN-VOC-AND-PARENTS)", PAR_FIND_WORD_IN_VOC_AND_PARENTS);
9675   UFWORDX("FIND-WORD-IN-VOC", FIND_WORD_IN_VOC);
9676   UFWORDX("FIND-WORD-IN-VOC-AND-PARENTS", FIND_WORD_IN_VOC_AND_PARENTS);
9677
9678   UFWORD(EXECUTE);
9679   UFWORDX("EXECUTE-TAIL", EXECUTE_TAIL);
9680   UFWORDX("@EXECUTE", LOAD_EXECUTE);
9681   UFWORDX("@EXECUTE-TAIL", LOAD_EXECUTE_TAIL);
9682   UFWORDX("(FORTH-CALL)", FORTH_CALL);
9683   UFWORDX("(FORTH-TAIL-CALL)", FORTH_TAIL_CALL);
9684
9685   UFWORD(DUP);
9686   UFWORD(NIP);
9687   UFWORD(TUCK);
9688   UFWORDX("?DUP", QDUP);
9689   UFWORDX("2DUP", DDUP);
9690   UFWORD(DROP);
9691   UFWORDX("2DROP", DDROP);
9692   UFWORD(SWAP);
9693   UFWORDX("2SWAP", DSWAP);
9694   UFWORD(OVER);
9695   UFWORDX("2OVER", DOVER);
9696   UFWORD(ROT);
9697   UFWORD(NROT);
9698   UFWORDX("PICK", PICK);
9699   UFWORDX("ROLL", ROLL);
9700
9701   UFWORD(RDUP);
9702   UFWORD(RDROP);
9703   UFWORDX(">R", DTOR);
9704   UFWORDX("R>", RTOD);
9705   UFWORDX("R@", RPEEK);
9706   UFWORDX("2>R", 2DTOR);
9707   UFWORDX("2R>", 2RTOD);
9708   UFWORDX("2R@", 2RPEEK);
9709   UFWORDX("2RDROP", 2RDROP);
9710   UFWORDX("RPICK", RPICK);
9711   UFWORDX("RROLL", RROLL);
9712   UFWORDX("RSWAP", RSWAP);
9713   UFWORDX("ROVER", ROVER);
9714   UFWORDX("RROT", RROT);
9715   UFWORDX("RNROT", RNROT);
9716
9717   UFWORDX("FLUSH-EMIT", FLUSH_EMIT);
9718   UFWORDX("(EMIT)", PAR_EMIT);
9719   UFWORDX("(NORM-EMIT-CHAR)", PAR_NORM_EMIT_CHAR);
9720   UFWORDX("(NORM-XEMIT-CHAR)", PAR_NORM_XEMIT_CHAR);
9721   UFWORDX("LASTCR?", LASTCRQ);
9722   UFWORDX("LASTCR!", LASTCRSET);
9723
9724   // simple math
9725   UFWORDX("+", PLUS);
9726   UFWORDX("-", MINUS);
9727   UFWORDX("*", MUL);
9728   UFWORDX("U*", UMUL);
9729   UFWORDX("/", DIV);
9730   UFWORDX("U/", UDIV);
9731   UFWORDX("MOD", MOD);
9732   UFWORDX("UMOD", UMOD);
9733   UFWORDX("/MOD", DIVMOD);
9734   UFWORDX("U/MOD", UDIVMOD);
9735   UFWORDX("*/", MULDIV);
9736   UFWORDX("U*/", UMULDIV);
9737   UFWORDX("*/MOD", MULDIVMOD);
9738   UFWORDX("U*/MOD", UMULDIVMOD);
9739   UFWORDX("M*", MMUL);
9740   UFWORDX("UM*", UMMUL);
9741   UFWORDX("M/MOD", MDIVMOD);
9742   UFWORDX("UM/MOD", UMDIVMOD);
9743   UFWORDX("UDS*", UDSMUL);
9744
9745   UFWORDX("SM/REM", SMREM);
9746   UFWORDX("FM/MOD", FMMOD);
9747
9748   UFWORDX("D-", DMINUS);
9749   UFWORDX("D+", DPLUS);
9750   UFWORDX("D=", DEQU);
9751   UFWORDX("D<", DLESS);
9752   UFWORDX("D<=", DLESSEQU);
9753   UFWORDX("DU<", DULESS);
9754   UFWORDX("DU<=", DULESSEQU);
9755
9756   UFWORD(ASH);
9757   UFWORD(LSH);
9758   UFWORD(ARSHIFT);
9759   UFWORD(LSHIFT);
9760   UFWORD(RSHIFT);
9761
9762   UFWORDX("~AND", BN_AND);
9763   UFWORDX("ABS", ABS);
9764   UFWORDX("NEGATE", NEGATE);
9765   UFWORDX("SIGN?", SIGNQ);
9766   UFWORDX("LO-WORD", LO_WORD);
9767   UFWORDX("HI-WORD", HI_WORD);
9768   UFWORDX("LO-BYTE", LO_BYTE);
9769   UFWORDX("HI-BYTE", HI_BYTE);
9770   UFWORDX("MIN", MIN);
9771   UFWORDX("MAX", MAX);
9772   UFWORDX("UMIN", UMIN);
9773   UFWORDX("UMAX", UMAX);
9774   UFWORDX("WITHIN", WITHIN);
9775   UFWORDX("UWITHIN", UWITHIN);
9776   UFWORDX("BOUNDS?", BOUNDSQ);
9777   UFWORDX("BSWAP16", BSWAP16);
9778   UFWORDX("BSWAP32", BSWAP32);
9779
9780   // for optimiser
9781   UFWORDX("(SWAP:1+:SWAP)", PAR_SWAP_INC_SWAP);
9782
9783   // logic
9784   UFWORDX("<", LESS);
9785   UFWORDX(">", GREAT);
9786   UFWORDX("<=", LESSEQU);
9787   UFWORDX(">=", GREATEQU);
9788   UFWORDX("U<", ULESS);
9789   UFWORDX("U>", UGREAT);
9790   UFWORDX("U<=", ULESSEQU);
9791   UFWORDX("U>=", UGREATEQU);
9792   UFWORDX("=", EQU);
9793   UFWORDX("<>", NOTEQU);
9794
9795   UFWORDX("0=", ZERO_EQU);
9796   UFWORDX("0<>", ZERO_NOTEQU);
9797   UFWORDX("0<", 0LESS);
9798   UFWORDX("0>", 0GREAT);
9799   UFWORDX("0<=", 0LESSEQU);
9800   UFWORDX("0>=", 0GREATEQU);
9801
9802   UFWORDX("NOT", ZERO_EQU);
9803   UFWORDX("NOTNOT", ZERO_NOTEQU);
9804
9805   UFWORD(BITNOT);
9806   UFWORD(AND);
9807   UFWORD(OR);
9808   UFWORD(XOR);
9809   UFWORDX("LOGAND", LOGAND);
9810   UFWORDX("LOGOR", LOGOR);
9811
9812   UFWORDX("2*", 2MUL);
9813   UFWORDX("4*", 4MUL);
9814   UFWORDX("8*", 8MUL);
9815   UFWORDX("2/", 2DIV);
9816   UFWORDX("4/", 4DIV);
9817   UFWORDX("8/", 8DIV);
9818   UFWORDX("2U/", 2UDIV);
9819   UFWORDX("4U/", 4UDIV);
9820   UFWORDX("8U/", 8UDIV);
9821
9822   UFWORDX("1+", 1ADD);
9823   UFWORDX("1-", 1SUB);
9824   UFWORDX("2+", 2ADD);
9825   UFWORDX("2-", 2SUB);
9826   UFWORDX("4+", 4ADD);
9827   UFWORDX("4-", 4SUB);
9828   UFWORDX("8+", 8ADD);
9829   UFWORDX("8-", 8SUB);
9830
9831   ufoDefineConstant("CELL", 4);
9832
9833   UFWORDX("CELL+", 4ADD);
9834   UFWORDX("CELL-", 4SUB);
9835
9836   UFWORDX("CELLS", 4MUL);
9837   UFWORDX("/CELLS", 4DIV);
9838   UFWORDX("+CELLS", ADD_CELLS);
9839   UFWORDX("-CELLS", SUB_CELLS);
9840
9841   UFWORDX("MEMCMP", MEMCMP);
9842   UFWORDX("MEMCMP-CI", MEMCMP_CI);
9843
9844   UFWORDX("CMOVE-CELLS", CMOVE_CELLS_FWD);
9845   UFWORDX("CMOVE>-CELLS", CMOVE_CELLS_BWD);
9846   UFWORDX("CMOVE", CMOVE_FWD);
9847   UFWORDX("CMOVE>", CMOVE_BWD);
9848   UFWORDX("MOVE", MOVE);
9849
9850   UFWORDX("FILL-CELLS", FILL_CELLS);
9851   UFWORDX("FILL", FILL);
9852
9853   // TIB and parser
9854   UFWORDX("(TIB-IN)", TIB_IN);
9855   UFWORDX("TIB-PEEKCH", TIB_PEEKCH);
9856   UFWORDX("TIB-PEEKCH-OFS", TIB_PEEKCH_OFS);
9857   UFWORDX("TIB-GETCH", TIB_GETCH);
9858   UFWORDX("TIB-SKIPCH", TIB_SKIPCH);
9859
9860   UFWORDX("REFILL", REFILL);
9861   UFWORDX("REFILL-NOCROSS", REFILL_NOCROSS);
9862
9863   ufoHiddenWords();
9864   UFWORDX("(PARSE)", PAR_PARSE);
9865   UFWORDX("(PARSE-SKIP-COMMENTS)", PAR_PARSE_SKIP_COMMENTS);
9866   ufoPublicWords();
9867   UFWORDX("PARSE-SKIP-BLANKS", PARSE_SKIP_BLANKS);
9868   UFWORDX("PARSE-NAME", PARSE_NAME);
9869   UFWORDX("PARSE-SKIP-LINE", PARSE_SKIP_LINE);
9870   UFWORDX("PARSE", PARSE);
9871
9872   ufoHiddenWords();
9873   UFWORDX("(VSP@)", PAR_GET_VSP);
9874   UFWORDX("(VSP!)", PAR_SET_VSP);
9875   UFWORDX("(VSP-AT@)", PAR_VSP_LOAD);
9876   UFWORDX("(VSP-AT!)", PAR_VSP_STORE);
9877   ufoDefineConstant("(VSP-SIZE)", UFO_VOCSTACK_SIZE);
9878
9879   ufoDefineConstant("(SP-SIZE)", UFO_DSTACK_SIZE);
9880   ufoDefineConstant("(RP-SIZE)", UFO_RSTACK_SIZE);
9881   ufoDefineConstant("(LP-SIZE)", UFO_LSTACK_SIZE);
9882   ufoPublicWords();
9883
9884   UFWORDX("ERROR", ERROR);
9885   UFWORDX("FATAL-ERROR", ERROR);
9886   UFWORDX("(USER-ABORT)", PAR_USER_ABORT);
9887
9888   ufoUserAbortCFA = ufoImgGetU32(ufoAddrCurrent);
9889   ufoUserAbortCFA = ufoImgGetU32(ufoUserAbortCFA + UFW_VOCAB_OFS_LATEST);
9890   ufoUserAbortCFA = UFO_LFA_TO_CFA(ufoUserAbortCFA);
9891
9892   UFWORDX("?ERROR", QERROR);
9893   UFWORDX("?NOT-ERROR", QNOTERROR);
9894
9895   // ABORT
9896   // ( -- )
9897   ufoInterpretLine(": ABORT  ` \"ABORT\" called` ERROR ;");
9898
9899   UFWORDX("GET-MSECS", GET_MSECS);
9900 }
9901
9902
9903 //==========================================================================
9904 //
9905 //  ufoInitBasicCompilerWords
9906 //
9907 //==========================================================================
9908 UFO_DISABLE_INLINE void ufoInitBasicCompilerWords (void) {
9909   // create "COMPILER" vocabulary
9910   ufoCompilerVocId = ufoCreateVoc("COMPILER", 0, UFW_FLAG_PROTECTED);
9911   ufoVocSetOnlyDefs(ufoCompilerVocId);
9912
9913   ufoDefineConstant("(CFAIDX-DO-FORTH)", ufoDoForthCFA);
9914   ufoDefineConstant("(CFAIDX-DO-VAR)", ufoDoVariableCFA);
9915   ufoDefineConstant("(CFAIDX-DO-VALUE)", ufoDoValueCFA);
9916   ufoDefineConstant("(CFAIDX-DO-CONST)", ufoDoConstCFA);
9917   ufoDefineConstant("(CFAIDX-DO-DEFER)", ufoDoDeferCFA);
9918   ufoDefineConstant("(CFAIDX-DO-DOES)", ufoDoDoesCFA);
9919   ufoDefineConstant("(CFAIDX-DO-REDIRECT)", ufoDoRedirectCFA);
9920   ufoDefineConstant("(CFAIDX-DO-VOC)", ufoDoVocCFA);
9921   ufoDefineConstant("(CFAIDX-DO-CREATE)", ufoDoCreateCFA);
9922   ufoDefineConstant("(CFAIDX-DO-USER-VAR)", ufoDoUserVariableCFA);
9923
9924   ufoDefineConstant("(WFLAG-IMMEDIATE)", UFW_FLAG_IMMEDIATE);
9925   ufoDefineConstant("(WFLAG-SMUDGE)", UFW_FLAG_SMUDGE);
9926   ufoDefineConstant("(WFLAG-NORETURN)", UFW_FLAG_NORETURN);
9927   ufoDefineConstant("(WFLAG-HIDDEN)", UFW_FLAG_HIDDEN);
9928   ufoDefineConstant("(WFLAG-CBLOCK)", UFW_FLAG_CBLOCK);
9929   ufoDefineConstant("(WFLAG-VOCAB)", UFW_FLAG_VOCAB);
9930   ufoDefineConstant("(WFLAG-SCOLON)", UFW_FLAG_SCOLON);
9931   ufoDefineConstant("(WFLAG-PROTECTED)", UFW_FLAG_PROTECTED);
9932
9933   ufoDefineConstant("(WARG-MASK)", UFW_WARG_MASK);
9934   ufoDefineConstant("(WARG-NONE)", UFW_WARG_NONE);
9935   ufoDefineConstant("(WARG-BRANCH)", UFW_WARG_BRANCH);
9936   ufoDefineConstant("(WARG-LIT)", UFW_WARG_LIT);
9937   ufoDefineConstant("(WARG-C4STRZ)", UFW_WARG_C4STRZ);
9938   ufoDefineConstant("(WARG-CFA)", UFW_WARG_CFA);
9939   ufoDefineConstant("(WARG-CBLOCK)", UFW_WARG_CBLOCK);
9940   ufoDefineConstant("(WARG-VOCID)", UFW_WARG_VOCID);
9941   ufoDefineConstant("(WARG-C1STRZ)", UFW_WARG_C1STRZ);
9942   ufoDefineConstant("(WARG-DATASKIP)", UFW_WARG_DATASKIP);
9943   ufoDefineConstant("(WARG-PFA)", UFW_WARG_PFA);
9944
9945   ufoDefineConstant("(VOCOFS-LATEST)", UFW_VOCAB_OFS_LATEST);
9946   ufoDefineConstant("(VOCOFS-VOCLINK)", UFW_VOCAB_OFS_VOCLINK);
9947   ufoDefineConstant("(VOCOFS-PARENT)", UFW_VOCAB_OFS_PARENT);
9948   ufoDefineConstant("(VOCOFS-HEADER)", UFW_VOCAB_OFS_HEADER);
9949   ufoDefineConstant("(VOCOFS-HTABLE)", UFW_VOCAB_OFS_HTABLE);
9950   ufoDefineConstant("(VOC-HTABLE-SIZE)", UFO_HASHTABLE_SIZE);
9951   ufoDefineConstant("(VOC-HTABLE-NOFLAG)", UFO_NO_HTABLE_FLAG);
9952
9953   ufoDefineConstant("(REDEFINE-WARN-DON'T-CARE)", UFO_REDEF_WARN_DONT_CARE);
9954   ufoDefineConstant("(REDEFINE-WARN-NONE)", UFO_REDEF_WARN_NONE);
9955   ufoDefineConstant("(REDEFINE-WARN-NORMAL)", UFO_REDEF_WARN_NORMAL);
9956   ufoDefineConstant("(REDEFINE-WARN-PARENTS)", UFO_REDEF_WARN_PARENTS);
9957
9958   ufoDefineConstant("WORD-REDEFINE-WARN-MODE", ufoAddrRedefineWarning);
9959
9960   UFWORDX("(BRANCH-ADDR!)", PAR_BRANCH_ADDR_POKE);
9961   UFWORDX("(BRANCH-ADDR@)", PAR_BRANCH_ADDR_PEEK);
9962
9963   UFWORDX("CFA,", CFA_COMMA);
9964   UFWORDX("(UNESCAPE)", PAR_UNESCAPE);
9965
9966   const uint32_t dropCFA = ufoFindWordChecked("FORTH:DROP");
9967   const uint32_t noopCFA = ufoFindWordChecked("FORTH:NOOP");
9968
9969   ufoDefineDefer("(AFTER-COMPILE-WORD)", dropCFA); // ( start-addr -- )
9970   ufoDefineDefer("(AFTER-COMPILE-LIT)", dropCFA); // ( start-addr -- )
9971   ufoDefineDefer("(JUMP-HERE-MARKED)", noopCFA); // ( -- )
9972   ufoDefineDefer("(RESET-SINOPT)", noopCFA); // ( -- )
9973
9974   ufoInterpretLine(
9975     ": ?EXEC  ( -- ) "
9976     "  FORTH:STATE FORTH:@ ` expecting interpretation mode` FORTH:?ERROR "
9977     ";");
9978
9979   ufoInterpretLine(
9980     ": ?COMP  ( -- ) "
9981     "  FORTH:STATE FORTH:@ ` expecting compilation mode` FORTH:?NOT-ERROR "
9982     ";");
9983
9984   ufoInterpretLine(
9985     ": EXEC?  ( -- bool ) "
9986     "  FORTH:STATE FORTH:@ FORTH:0= "
9987     ";");
9988
9989   ufoInterpretLine(
9990     ": COMP?  ( -- bool ) "
9991     "  FORTH:STATE FORTH:@ FORTH:0<> "
9992     ";");
9993
9994   ufoInterpretLine(
9995     ": EXEC!  ( -- ) "
9996     "  FORTH:STATE FORTH:0! "
9997     ";");
9998
9999   ufoInterpretLine(
10000     ": COMP!  ( -- ) "
10001     "  FORTH:STATE FORTH:1! "
10002     ";");
10003
10004   UFWORDX("(CREATE-WORD-HEADER)", PAR_CREATE_WORD_HEADER);
10005   UFWORDX("(CREATE-NAMELESS-WORD-HEADER)", PAR_CREATE_NAMELESS_WORD_HEADER);
10006
10007   ufoVocSetOnlyDefs(ufoForthVocId);
10008
10009   // [
10010   ufoInterpretLine("!: [  COMPILER:?COMP COMPILER:EXEC! ;");
10011   // ]
10012   ufoInterpretLine(": ]  COMPILER:?EXEC COMPILER:COMP! ;");
10013
10014   ufoInterpretLine(
10015     ": COMPILE,  ( n -- ) "
10016     "  HERE >R , R> COMPILER:(AFTER-COMPILE-WORD) "
10017     ";");
10018
10019   ufoInterpretLine(
10020     ": COMPILE-IMM,  ( n -- ) "
10021     "  , "
10022     ";");
10023
10024   ufoDefineVar("(COMPILE-START-HERE)", 0);
10025
10026   ufoInterpretLine(
10027     ": COMPILE-START,  ( n -- ) "
10028     "  HERE (COMPILE-START-HERE) ! , "
10029     ";");
10030
10031   ufoInterpretLine(
10032     ": COMPILE-ARG,  ( n -- ) "
10033     "  , "
10034     ";");
10035
10036   ufoInterpretLine(
10037     ": COMPILE-END,  ( n -- ) "
10038     "  , (COMPILE-START-HERE) @ (COMPILE-START-HERE) 0! "
10039     "  COMPILER:(AFTER-COMPILE-WORD) "
10040     ";");
10041
10042   // LITERAL
10043   // ( C:n -- )  ( E:n -- n )
10044   ufoInterpretLine(
10045     ": LITERAL  ( C:n -- )  ( E:n -- n ) "
10046     "  COMPILER:COMP? FORTH:(0BRANCH) $literal_exit "
10047     "  HERE >R X-COMPILE FORTH:(LIT) , "
10048     "  R> COMPILER:(AFTER-COMPILE-LIT) "
10049     "$literal_exit: "
10050     ";");
10051   //ufoDecompileWord(ufoFindWordChecked("LITERAL"));
10052
10053   // CFALITERAL
10054   // ( C:cfa -- )  ( E:cfa -- cfa )
10055   ufoInterpretLine(
10056     ": CFALITERAL  ( C:cfa -- )  ( E:cfa -- cfa ) "
10057     "  COMPILER:COMP? FORTH:(0BRANCH) $cfa_literal_exit "
10058     "  HERE >R X-COMPILE FORTH:(LITCFA) , "
10059     "  R> COMPILER:(AFTER-COMPILE-LIT) "
10060     "$cfa_literal_exit: "
10061     ";");
10062
10063   // PFALITERAL
10064   // ( C:pfa -- )  ( E:pfa -- pfa )
10065   ufoInterpretLine(
10066     ": PFALITERAL  ( C:pfa -- )  ( E:pfa -- pfa ) "
10067     "  COMPILER:COMP? FORTH:(0BRANCH) $pfa_literal_exit "
10068     "  HERE >R X-COMPILE FORTH:(LITPFA) , "
10069     "  R> COMPILER:(AFTER-COMPILE-LIT) "
10070     "$pfa_literal_exit: "
10071     ";");
10072
10073   ufoInterpretLine("!: IMM-LITERAL  LITERAL ;");
10074   ufoInterpretLine("!: IMM-CFALITERAL  CFALITERAL ;");
10075   ufoInterpretLine("!: IMM-PFALITERAL  PFALITERAL ;");
10076 }
10077
10078
10079 //==========================================================================
10080 //
10081 //  ufoInitHandleWords
10082 //
10083 //==========================================================================
10084 UFO_DISABLE_INLINE void ufoInitHandleWords (void) {
10085   // create "HANDLE" vocabulary
10086   const uint32_t handleVocId = ufoCreateVoc("HANDLE", 0, UFW_FLAG_PROTECTED);
10087   ufoVocSetOnlyDefs(handleVocId);
10088   UFWORDX("NEW", PAR_NEW_HANDLE);
10089   UFWORDX("FREE", PAR_FREE_HANDLE);
10090   UFWORDX("TYPEID@", PAR_HANDLE_GET_TYPEID);
10091   UFWORDX("TYPEID!", PAR_HANDLE_SET_TYPEID);
10092   UFWORDX("SIZE@", PAR_HANDLE_GET_SIZE);
10093   UFWORDX("SIZE!", PAR_HANDLE_SET_SIZE);
10094   UFWORDX("USED@", PAR_HANDLE_GET_USED);
10095   UFWORDX("USED!", PAR_HANDLE_SET_USED);
10096   UFWORDX("C@", PAR_HANDLE_LOAD_BYTE);
10097   UFWORDX("W@", PAR_HANDLE_LOAD_WORD);
10098   UFWORDX("@", PAR_HANDLE_LOAD_CELL);
10099   UFWORDX("C!", PAR_HANDLE_STORE_BYTE);
10100   UFWORDX("W!", PAR_HANDLE_STORE_WORD);
10101   UFWORDX("!", PAR_HANDLE_STORE_CELL);
10102   UFWORDX("LOAD-FILE", PAR_HANDLE_LOAD_FILE);
10103   ufoVocSetOnlyDefs(ufoForthVocId);
10104 }
10105
10106
10107 //==========================================================================
10108 //
10109 //  ufoInitHigherWords
10110 //
10111 //==========================================================================
10112 UFO_DISABLE_INLINE void ufoInitHigherWords (void) {
10113   UFWORDX("(INCLUDE)", PAR_INCLUDE);
10114   UFWORDX("(INCLUDE-DROP)", PAR_INCLUDE_DROP);
10115   UFWORDX("(INCLUDE-BUILD-NAME)", PAR_INCLUDE_BUILD_NAME);
10116   UFWORDX("(INCLUDE-NO-REFILL)", PAR_INCLUDE_NO_REFILL);
10117   UFWORDX("(INCLUDE-LINE-SEEK)", PAR_INCLUDE_LINE_SEEK);
10118
10119   UFWORDX("(INCLUDE-LINE-FOFS)", PAR_INCLUDE_LINE_FOFS);
10120   UFWORDX("(INCLUDE-DEPTH)", PAR_INCLUDE_DEPTH);
10121   UFWORDX("(INCLUDE-FILE-ID)", PAR_INCLUDE_FILE_ID);
10122   UFWORDX("(INCLUDE-FILE-LINE)", PAR_INCLUDE_FILE_LINE);
10123   UFWORDX("(INCLUDE-FILE-NAME)", PAR_INCLUDE_FILE_NAME);
10124
10125   UFWORDX("($DEFINED?)", PAR_DLR_DEFINEDQ);
10126   UFWORDX("($DEFINE)", PAR_DLR_DEFINE);
10127   UFWORDX("($UNDEF)", PAR_DLR_UNDEF);
10128
10129   UFWORDX_IMM("$INCLUDE", DLR_INCLUDE_IMM);
10130   UFWORDX_IMM("$INCLUDE-ONCE", DLR_INCLUDE_ONCE_IMM);
10131 }
10132
10133
10134 //==========================================================================
10135 //
10136 //  ufoInitStringWords
10137 //
10138 //==========================================================================
10139 UFO_DISABLE_INLINE void ufoInitStringWords (void) {
10140   // create "STRING" vocabulary
10141   const uint32_t stringVocId = ufoCreateVoc("STRING", 0, UFW_FLAG_PROTECTED);
10142   ufoVocSetOnlyDefs(stringVocId);
10143   UFWORDX("=", STREQU);
10144   UFWORDX("=CI", STREQUCI);
10145   UFWORDX("SEARCH", SEARCH);
10146   UFWORDX("HASH", STRHASH);
10147   UFWORDX("HASH-CI", STRHASHCI);
10148   UFWORDX("CHAR-UPPER", CHAR_UPPER);
10149   UFWORDX("CHAR-LOWER", CHAR_LOWER);
10150   UFWORDX("UPPER", STRUPPER);
10151   UFWORDX("LOWER", STRLOWER);
10152   UFWORDX("(CHAR-DIGIT)", CHAR_DIGIT);
10153   UFWORDX("DIGIT", DIGIT);
10154   UFWORDX("DIGIT?", DIGITQ);
10155
10156   UFWORDX("IS-DIGIT", IS_DIGIT);
10157   UFWORDX("IS-BIN-DIGIT", IS_BIN_DIGIT);
10158   UFWORDX("IS-OCT-DIGIT", IS_OCT_DIGIT);
10159   UFWORDX("IS-HEX-DIGIT", IS_HEX_DIGIT);
10160   UFWORDX("IS-ALPHA", IS_ALPHA);
10161   UFWORDX("IS-UNDER-DOT", IS_UNDER_DOT);
10162   UFWORDX("IS-ALNUM", IS_ALNUM);
10163   UFWORDX("IS-ID-START", IS_ID_START);
10164   UFWORDX("IS-ID-CHAR", IS_ID_CHAR);
10165
10166   ufoVocSetOnlyDefs(ufoForthVocId);
10167 }
10168
10169
10170 //==========================================================================
10171 //
10172 //  ufoInitDebugWords
10173 //
10174 //==========================================================================
10175 UFO_DISABLE_INLINE void ufoInitDebugWords (void) {
10176   // create "DEBUG" vocabulary
10177   const uint32_t debugVocId = ufoCreateVoc("DEBUG", 0, UFW_FLAG_PROTECTED);
10178   ufoVocSetOnlyDefs(debugVocId);
10179   UFWORDX("(DECOMPILE-CFA)", DEBUG_DECOMPILE_CFA);
10180   UFWORDX("(DECOMPILE-MEM)", DEBUG_DECOMPILE_MEM);
10181   UFWORDX("BACKTRACE", UFO_BACKTRACE);
10182   UFWORDX("DUMP-STACK", DUMP_STACK);
10183   #ifdef UFO_MTASK_ALLOWED
10184   UFWORDX("BACKTRACE-TASK", UFO_BACKTRACE_TASK);
10185   UFWORDX("DUMP-STACK-TASK", DUMP_STACK_TASK);
10186   UFWORDX("DUMP-RSTACK-TASK", DUMP_RSTACK_TASK);
10187   #endif
10188   UFWORDX("(BP)", MT_DEBUGGER_BP);
10189   UFWORDX("IP->NFA", IP2NFA);
10190   UFWORDX("IP->FILE/LINE", IP2FILELINE);
10191   UFWORDX("IP->FILE-HASH/LINE", IP2FILEHASHLINE);
10192   #ifdef UFO_MTASK_ALLOWED
10193   UFWORDX("SINGLE-STEP@", DBG_GET_SS);
10194   #endif
10195   ufoVocSetOnlyDefs(ufoForthVocId);
10196 }
10197
10198
10199 //==========================================================================
10200 //
10201 //  ufoInitMTWords
10202 //
10203 //==========================================================================
10204 UFO_DISABLE_INLINE void ufoInitMTWords (void) {
10205   // create "MTASK" vocabulary
10206   const uint32_t mtVocId = ufoCreateVoc("MTASK", 0, UFW_FLAG_PROTECTED);
10207   ufoVocSetOnlyDefs(mtVocId);
10208   #ifdef UFO_MTASK_ALLOWED
10209   UFWORDX("NEW-STATE", MT_NEW_STATE);
10210   UFWORDX("FREE-STATE", MT_FREE_STATE);
10211   #endif
10212   UFWORDX("STATE-NAME@", MT_GET_STATE_NAME);
10213   UFWORDX("STATE-NAME!", MT_SET_STATE_NAME);
10214   #ifdef UFO_MTASK_ALLOWED
10215   UFWORDX("STATE-FIRST", MT_STATE_FIRST);
10216   UFWORDX("STATE-NEXT", MT_STATE_NEXT);
10217   UFWORDX("YIELD-TO", MT_YIELD_TO);
10218   UFWORDX("SET-SELF-AS-DEBUGGER", MT_SET_SELF_AS_DEBUGGER);
10219   UFWORDX("DEBUGGER-RESUME", MT_RESUME_DEBUGEE);
10220   UFWORDX("DEBUGGER-SINGLE-STEP", MT_SINGLE_STEP_DEBUGEE);
10221   #endif
10222   UFWORDX("ACTIVE-STATE", MT_ACTIVE_STATE);
10223   UFWORDX("STATE-IP@", MT_STATE_IP_GET);
10224   UFWORDX("STATE-IP!", MT_STATE_IP_SET);
10225   UFWORDX("STATE-A>", MT_STATE_REGA_GET);
10226   UFWORDX("STATE->A", MT_STATE_REGA_SET);
10227   UFWORDX("STATE-USER@", MT_STATE_USER_GET);
10228   UFWORDX("STATE-USER!", MT_STATE_USER_SET);
10229   UFWORDX("YIELDED-FROM", MT_YIELDED_FROM);
10230   UFWORDX("STATE-SP@", MT_DSTACK_DEPTH_GET);
10231   UFWORDX("STATE-RP@", MT_RSTACK_DEPTH_GET);
10232   UFWORDX("STATE-LP@", MT_LP_GET);
10233   UFWORDX("STATE-LBP@", MT_LBP_GET);
10234   UFWORDX("STATE-SP!", MT_DSTACK_DEPTH_SET);
10235   UFWORDX("STATE-RP!", MT_RSTACK_DEPTH_SET);
10236   UFWORDX("STATE-LP!", MT_LP_SET);
10237   UFWORDX("STATE-LBP!", MT_LBP_SET);
10238   UFWORDX("STATE-DS@", MT_DSTACK_LOAD);
10239   UFWORDX("STATE-RS@", MT_RSTACK_LOAD);
10240   UFWORDX("STATE-LS@", MT_LSTACK_LOAD);
10241   UFWORDX("STATE-DS!", MT_DSTACK_STORE);
10242   UFWORDX("STATE-RS!", MT_RSTACK_STORE);
10243   UFWORDX("STATE-LS!", MT_LSTACK_STORE);
10244   UFWORDX("STATE-VSP@", MT_VSP_GET);
10245   UFWORDX("STATE-VSP!", MT_VSP_SET);
10246   UFWORDX("STATE-VSP-AT@", MT_VSP_LOAD);
10247   UFWORDX("STATE-VSP-AT!", MT_VSP_STORE);
10248   ufoVocSetOnlyDefs(ufoForthVocId);
10249 }
10250
10251
10252 //==========================================================================
10253 //
10254 //  ufoInitTTYWords
10255 //
10256 //==========================================================================
10257 UFO_DISABLE_INLINE void ufoInitTTYWords (void) {
10258   // create "TTY" vocabulary
10259   const uint32_t ttyVocId = ufoCreateVoc("TTY", 0, UFW_FLAG_PROTECTED);
10260   ufoVocSetOnlyDefs(ttyVocId);
10261   UFWORDX("TTY?", TTY_TTYQ);
10262   UFWORDX("RAW?", TTY_RAWQ);
10263   UFWORDX("SIZE", TTY_SIZE);
10264   UFWORDX("SET-RAW", TTY_SET_RAW);
10265   UFWORDX("SET-COOKED", TTY_SET_COOKED);
10266   UFWORDX("RAW-EMIT", TTY_RAW_EMIT);
10267   UFWORDX("RAW-TYPE", TTY_RAW_TYPE);
10268   UFWORDX("RAW-FLUSH", TTY_RAW_FLUSH);
10269   UFWORDX("RAW-READCH", TTY_RAW_READCH);
10270   UFWORDX("RAW-READY?", TTY_RAW_READYQ);
10271   ufoVocSetOnlyDefs(ufoForthVocId);
10272 }
10273
10274
10275 //==========================================================================
10276 //
10277 //  ufoInitFilesWords
10278 //
10279 //==========================================================================
10280 UFO_DISABLE_INLINE void ufoInitFilesWords (void) {
10281   // create "FILES" vocabulary
10282   const uint32_t filesVocId = ufoCreateVoc("FILES", 0, UFW_FLAG_PROTECTED);
10283   ufoVocSetOnlyDefs(filesVocId);
10284   ufoDefineConstant("SEEK-SET", SEEK_SET);
10285   ufoDefineConstant("SEEK-CUR", SEEK_CUR);
10286   ufoDefineConstant("SEEK-END", SEEK_END);
10287
10288   UFWORDX("OPEN-R/O", FILES_OPEN_RO);
10289   UFWORDX("OPEN-R/W", FILES_OPEN_RW);
10290   UFWORDX("CREATE", FILES_CREATE);
10291   UFWORDX("CLOSE", FILES_CLOSE);
10292   UFWORDX("TELL", FILES_TELL);
10293   UFWORDX("SEEK-EX", FILES_SEEK_EX);
10294   UFWORDX("SIZE", FILES_SIZE);
10295   UFWORDX("READ", FILES_READ);
10296   UFWORDX("READ-EXACT", FILES_READ_EXACT);
10297   UFWORDX("WRITE", FILES_WRITE);
10298
10299   UFWORDX("UNLINK", FILES_UNLINK);
10300
10301   UFWORDX("ERRNO", FILES_ERRNO);
10302
10303   ufoInterpretLine(
10304     ": SEEK  ( ofs handle -- success? ) "
10305     "  SEEK-SET FORTH:SWAP SEEK-EX "
10306     ";");
10307
10308   ufoVocSetOnlyDefs(ufoForthVocId);
10309 }
10310
10311
10312 //==========================================================================
10313 //
10314 //  ufoInitVeryVeryHighWords
10315 //
10316 //==========================================================================
10317 UFO_DISABLE_INLINE void ufoInitVeryVeryHighWords (void) {
10318   // interpret defer
10319   //ufoDefineDefer("INTERPRET", idumbCFA);
10320
10321   ufoDefineEmitType();
10322
10323   // ( addr count FALSE -- addr count FALSE / TRUE )
10324   ufoDefineSColonForth("(INTERPRET-CHECK-WORD)");
10325   ufoDoneForth();
10326   // ( addr count FALSE -- addr count FALSE / TRUE )
10327   ufoDefineSColonForth("(INTERPRET-WORD-NOT-FOUND)");
10328   ufoDoneForth();
10329   // ( addr count -- addr count )
10330   ufoDefineSColonForth("(INTERPRET-WORD-NOT-FOUND-POST)");
10331   ufoDoneForth();
10332   // ( -- ) -- called in "EXIT", before compiling "FORTH:(EXIT)"
10333   ufoDefineSColonForth("(EXIT-EXTENDER)");
10334   ufoDoneForth();
10335
10336   // EXIT  ( -- )
10337   ufoInterpretLine(
10338     "!: EXIT  ( -- ) "
10339     " COMPILER:?COMP (EXIT-EXTENDER) "
10340     //" HERE >R "
10341     " COMPILE FORTH:(EXIT) "
10342     //" R> COMPILER:(AFTER-COMPILE-WORD) "
10343     ";");
10344
10345   ufoDefineInterpret();
10346
10347   //ufoDumpVocab(ufoCompilerVocId);
10348
10349   ufoInterpretLine(
10350     ": RUN-INTERPRET-LOOP "
10351     "$run-interp-loop-again: "
10352     "  RP0! INTERPRET (UFO-INTERPRET-FINISHED-ACTION) "
10353     "  FORTH:(BRANCH) $run-interp-loop-again "
10354     ";");
10355 }
10356
10357 #define UFO_ADD_DO_CFA(cfx_)  do { \
10358   ufoDo##cfx_##CFA = ufoCFAsUsed | UFO_ADDR_CFA_BIT; \
10359   ufoForthCFAs[ufoCFAsUsed] = &ufoDo##cfx_; \
10360   ufoCFAsUsed += 1; \
10361 } while (0)
10362
10363
10364 //==========================================================================
10365 //
10366 //  ufoBadCFA
10367 //
10368 //==========================================================================
10369 static void ufoBadCFA (uint32_t pfa) {
10370   ufoFatal("tried to execute an invalid CFA: IP=%u", ufoIP - 4u);
10371 }
10372
10373
10374 //==========================================================================
10375 //
10376 //  ufoInitCommon
10377 //
10378 //==========================================================================
10379 UFO_DISABLE_INLINE void ufoInitCommon (void) {
10380   ufoVSP = 0;
10381   ufoForthVocId = 0; ufoCompilerVocId = 0;
10382
10383   //ufoForthCFAs = calloc(UFO_MAX_NATIVE_CFAS, sizeof(ufoForthCFAs[0]));
10384   for (uint32_t f = 0; f < UFO_MAX_NATIVE_CFAS; f += 1) ufoForthCFAs[f] = &ufoBadCFA;
10385
10386   // allocate default TIB handle
10387   //UfoHandle *tibh = ufoAllocHandle(0x69a029a6); // arbitrary number
10388   //ufoDefTIB = tibh->ufoHandle;
10389
10390   /*ufoForthCFAs[0] = NULL;*/ ufoCFAsUsed = 1u;
10391   UFO_ADD_DO_CFA(Forth);
10392   UFO_ADD_DO_CFA(Variable);
10393   UFO_ADD_DO_CFA(Value);
10394   UFO_ADD_DO_CFA(Const);
10395   UFO_ADD_DO_CFA(Defer);
10396   UFO_ADD_DO_CFA(Does);
10397   UFO_ADD_DO_CFA(Redirect);
10398   UFO_ADD_DO_CFA(Voc);
10399   UFO_ADD_DO_CFA(Create);
10400   UFO_ADD_DO_CFA(UserVariable);
10401
10402   //fprintf(stderr, "DO-FORTH-CFA: 0x%08x\n", ufoDoForthCFA);
10403
10404   ufoInitBaseDict();
10405
10406   // create "FORTH" vocabulary (it should be the first one)
10407   ufoForthVocId = ufoCreateVoc("FORTH", 0, UFW_FLAG_PROTECTED);
10408   ufoVocSetOnlyDefs(ufoForthVocId);
10409
10410   // base low-level interpreter words
10411   ufoInitBasicWords();
10412
10413   // more FORTH words
10414   ufoInitMoreWords();
10415
10416   // some COMPILER words
10417   ufoInitBasicCompilerWords();
10418
10419   // STRING vocabulary
10420   ufoInitStringWords();
10421
10422   // DEBUG vocabulary
10423   ufoInitDebugWords();
10424
10425   // MTASK vocabulary
10426   ufoInitMTWords();
10427
10428   // HANDLE vocabulary
10429   ufoInitHandleWords();
10430
10431   // TTY vocabulary
10432   ufoInitTTYWords();
10433
10434   // FILES vocabulary
10435   ufoInitFilesWords();
10436
10437   // some higher-level FORTH words (includes, etc.)
10438   ufoInitHigherWords();
10439
10440   // very-very high-level FORTH words
10441   ufoInitVeryVeryHighWords();
10442
10443   ufoFinalLabelCheck();
10444
10445   #if 0
10446   ufoDecompileWord(ufoFindWordChecked("RUN-INTERPRET-LOOP"));
10447   #endif
10448
10449   ufoReset();
10450 }
10451
10452 #undef UFC
10453
10454
10455 // ////////////////////////////////////////////////////////////////////////// //
10456 // virtual machine executor
10457 //
10458
10459
10460 //==========================================================================
10461 //
10462 //  ufoRunVMxxx
10463 //
10464 //  address interpreter
10465 //
10466 //==========================================================================
10467 static void ufoRunVMxxx (uint32_t cfa) {
10468   UFO_EXEC_CFA(cfa);
10469   // VM execution loop
10470   for (;;) {
10471     cfa = ufoImgGetU32(ufoIP); ufoIP += 4u;
10472     UFO_EXEC_CFA(cfa);
10473   }
10474 }
10475
10476
10477 //==========================================================================
10478 //
10479 //  ufoRunVMCFA
10480 //
10481 //==========================================================================
10482 static void ufoRunVMCFA (uint32_t cfa) {
10483   if (ufoInRunWord) ufoFatal("cannot run VM recursively");
10484   ufoInRunWord = 1;
10485   if (setjmp(ufoStopVMJP) == 0) {
10486     ufoRunVMxxx(cfa);
10487   }
10488   ufoInRunWord = 0;
10489 }
10490
10491
10492 // ////////////////////////////////////////////////////////////////////////// //
10493 // high-level API
10494 //
10495
10496 //==========================================================================
10497 //
10498 //  ufoRegisterWord
10499 //
10500 //  register new word
10501 //
10502 //==========================================================================
10503 uint32_t ufoRegisterWord (const char *wname, ufoNativeCFA cfa, uint32_t flags) {
10504   ufo_assert(cfa != NULL);
10505   ufo_assert(wname != NULL && wname[0] != 0);
10506   uint32_t cfaidx = ufoCFAsUsed;
10507   if (cfaidx >= UFO_MAX_NATIVE_CFAS) ufoFatal("too many native words");
10508   ufoForthCFAs[cfaidx] = cfa;
10509   ufoCFAsUsed += 1;
10510   //ufoDefineNative(wname, xcfa, 0);
10511   cfaidx |= UFO_ADDR_CFA_BIT;
10512   flags &= 0xffffff00u;
10513   ufoCreateWordHeader(wname, flags);
10514   const uint32_t res = UFO_GET_DP();
10515   ufoImgEmitCFA(cfaidx);
10516   return res;
10517 }
10518
10519
10520 //==========================================================================
10521 //
10522 //  ufoRegisterDataWord
10523 //
10524 //==========================================================================
10525 static uint32_t ufoRegisterDataWord (const char *wname, uint32_t cfaidx, uint32_t value,
10526                                      uint32_t flags)
10527 {
10528   ufo_assert(wname != NULL && wname[0] != 0);
10529   flags &= 0xffffff00u;
10530   ufoCreateWordHeader(wname, flags);
10531   ufoImgEmitCFA(cfaidx);
10532   const uint32_t res = UFO_GET_DP();
10533   ufoImgEmitU32(value);
10534   return res;
10535 }
10536
10537
10538 //==========================================================================
10539 //
10540 //  ufoRegisterConstant
10541 //
10542 //==========================================================================
10543 void ufoRegisterConstant (const char *wname, uint32_t value, uint32_t flags) {
10544   (void)ufoRegisterDataWord(wname, ufoDoConstCFA, value, flags);
10545 }
10546
10547
10548 //==========================================================================
10549 //
10550 //  ufoRegisterVariable
10551 //
10552 //==========================================================================
10553 uint32_t ufoRegisterVariable (const char *wname, uint32_t value, uint32_t flags) {
10554   return ufoRegisterDataWord(wname, ufoDoVariableCFA, value, flags);
10555 }
10556
10557
10558 //==========================================================================
10559 //
10560 //  ufoRegisterValue
10561 //
10562 //==========================================================================
10563 uint32_t ufoRegisterValue (const char *wname, uint32_t value, uint32_t flags) {
10564   return ufoRegisterDataWord(wname, ufoDoValueCFA, value, flags);
10565 }
10566
10567
10568 //==========================================================================
10569 //
10570 //  ufoRegisterDefer
10571 //
10572 //==========================================================================
10573 uint32_t ufoRegisterDefer (const char *wname, uint32_t value, uint32_t flags) {
10574   return ufoRegisterDataWord(wname, ufoDoDeferCFA, value, flags);
10575 }
10576
10577
10578 //==========================================================================
10579 //
10580 //  ufoFindWordInVocabulary
10581 //
10582 //  check if we have the corresponding word.
10583 //  return CFA suitable for executing, or 0.
10584 //
10585 //==========================================================================
10586 uint32_t ufoFindWordInVocabulary (const char *wname, uint32_t vocid) {
10587   if (wname == NULL || wname[0] == 0) return 0;
10588   size_t wlen = strlen(wname);
10589   if (wlen >= UFO_MAX_WORD_LENGTH) return 0;
10590   return ufoFindWordInVocAndParents(wname, (uint32_t)wlen, 0, vocid, 0);
10591 }
10592
10593
10594 //==========================================================================
10595 //
10596 //  ufoGetIP
10597 //
10598 //==========================================================================
10599 uint32_t ufoGetIP (void) {
10600   return ufoIP;
10601 }
10602
10603
10604 //==========================================================================
10605 //
10606 //  ufoSetIP
10607 //
10608 //==========================================================================
10609 void ufoSetIP (uint32_t newip) {
10610   ufoIP = newip;
10611 }
10612
10613
10614 //==========================================================================
10615 //
10616 //  ufoIsExecuting
10617 //
10618 //==========================================================================
10619 int ufoIsExecuting (void) {
10620   return (ufoImgGetU32(ufoAddrSTATE) == 0);
10621 }
10622
10623
10624 //==========================================================================
10625 //
10626 //  ufoIsCompiling
10627 //
10628 //==========================================================================
10629 int ufoIsCompiling (void) {
10630   return (ufoImgGetU32(ufoAddrSTATE) != 0);
10631 }
10632
10633
10634 //==========================================================================
10635 //
10636 //  ufoSetExecuting
10637 //
10638 //==========================================================================
10639 void ufoSetExecuting (void) {
10640   ufoImgPutU32(ufoAddrSTATE, 0);
10641 }
10642
10643
10644 //==========================================================================
10645 //
10646 //  ufoSetCompiling
10647 //
10648 //==========================================================================
10649 void ufoSetCompiling (void) {
10650   ufoImgPutU32(ufoAddrSTATE, 1);
10651 }
10652
10653
10654 //==========================================================================
10655 //
10656 //  ufoGetHere
10657 //
10658 //==========================================================================
10659 uint32_t ufoGetHere () {
10660   return UFO_GET_DP();
10661 }
10662
10663
10664 //==========================================================================
10665 //
10666 //  ufoGetPad
10667 //
10668 //==========================================================================
10669 uint32_t ufoGetPad () {
10670   return UFO_PAD_ADDR;
10671 }
10672
10673
10674 //==========================================================================
10675 //
10676 //  ufoTIBPeekCh
10677 //
10678 //==========================================================================
10679 uint8_t ufoTIBPeekCh (uint32_t ofs) {
10680   return ufoTibPeekChOfs(ofs);
10681 }
10682
10683
10684 //==========================================================================
10685 //
10686 //  ufoTIBGetCh
10687 //
10688 //==========================================================================
10689 uint8_t ufoTIBGetCh (void) {
10690   return ufoTibGetCh();
10691 }
10692
10693
10694 //==========================================================================
10695 //
10696 //  ufoTIBSkipCh
10697 //
10698 //==========================================================================
10699 void ufoTIBSkipCh (void) {
10700   ufoTibSkipCh();
10701 }
10702
10703
10704 //==========================================================================
10705 //
10706 //  ufoTIBSRefill
10707 //
10708 //  returns 0 on EOF
10709 //
10710 //==========================================================================
10711 int ufoTIBSRefill (int allowCrossIncludes) {
10712   return ufoLoadNextLine(allowCrossIncludes);
10713 }
10714
10715
10716 //==========================================================================
10717 //
10718 //  ufoPeekData
10719 //
10720 //==========================================================================
10721 uint32_t ufoPeekData (void) {
10722   return ufoPeek();
10723 }
10724
10725
10726 //==========================================================================
10727 //
10728 //  ufoPopData
10729 //
10730 //==========================================================================
10731 uint32_t ufoPopData (void) {
10732   return ufoPop();
10733 }
10734
10735
10736 //==========================================================================
10737 //
10738 //  ufoPushData
10739 //
10740 //==========================================================================
10741 void ufoPushData (uint32_t value) {
10742   return ufoPush(value);
10743 }
10744
10745
10746 //==========================================================================
10747 //
10748 //  ufoPushBoolData
10749 //
10750 //==========================================================================
10751 void ufoPushBoolData (int val) {
10752   ufoPushBool(val);
10753 }
10754
10755
10756 //==========================================================================
10757 //
10758 //  ufoPeekRet
10759 //
10760 //==========================================================================
10761 uint32_t ufoPeekRet (void) {
10762   return ufoRPeek();
10763 }
10764
10765
10766 //==========================================================================
10767 //
10768 //  ufoPopRet
10769 //
10770 //==========================================================================
10771 uint32_t ufoPopRet (void) {
10772   return ufoRPop();
10773 }
10774
10775
10776 //==========================================================================
10777 //
10778 //  ufoPushRet
10779 //
10780 //==========================================================================
10781 void ufoPushRet (uint32_t value) {
10782   return ufoRPush(value);
10783 }
10784
10785
10786 //==========================================================================
10787 //
10788 //  ufoPushBoolRet
10789 //
10790 //==========================================================================
10791 void ufoPushBoolRet (int val) {
10792   ufoRPush(val ? ufoTrueValue : 0);
10793 }
10794
10795
10796 //==========================================================================
10797 //
10798 //  ufoPeekByte
10799 //
10800 //==========================================================================
10801 uint8_t ufoPeekByte (uint32_t addr) {
10802   return ufoImgGetU8(addr);
10803 }
10804
10805
10806 //==========================================================================
10807 //
10808 //  ufoPeekWord
10809 //
10810 //==========================================================================
10811 uint16_t ufoPeekWord (uint32_t addr) {
10812   ufoPush(addr);
10813   UFCALL(WPEEK);
10814   return ufoPop();
10815 }
10816
10817
10818 //==========================================================================
10819 //
10820 //  ufoPeekCell
10821 //
10822 //==========================================================================
10823 uint32_t ufoPeekCell (uint32_t addr) {
10824   ufoPush(addr);
10825   UFCALL(PEEK);
10826   return ufoPop();
10827 }
10828
10829
10830 //==========================================================================
10831 //
10832 //  ufoPokeByte
10833 //
10834 //==========================================================================
10835 void ufoPokeByte (uint32_t addr, uint32_t value) {
10836   ufoImgPutU8(addr, value);
10837 }
10838
10839
10840 //==========================================================================
10841 //
10842 //  ufoPokeWord
10843 //
10844 //==========================================================================
10845 void ufoPokeWord (uint32_t addr, uint32_t value) {
10846   ufoPush(value);
10847   ufoPush(addr);
10848   UFCALL(WPOKE);
10849 }
10850
10851
10852 //==========================================================================
10853 //
10854 //  ufoPokeCell
10855 //
10856 //==========================================================================
10857 void ufoPokeCell (uint32_t addr, uint32_t value) {
10858   ufoPush(value);
10859   ufoPush(addr);
10860   UFCALL(POKE);
10861 }
10862
10863
10864 //==========================================================================
10865 //
10866 //  ufoGetPAD
10867 //
10868 //==========================================================================
10869 uint32_t ufoGetPAD (void) {
10870   return UFO_PAD_ADDR;
10871 }
10872
10873
10874 //==========================================================================
10875 //
10876 //  ufoEmitByte
10877 //
10878 //==========================================================================
10879 void ufoEmitByte (uint32_t value) {
10880   ufoImgEmitU8(value);
10881 }
10882
10883
10884 //==========================================================================
10885 //
10886 //  ufoEmitWord
10887 //
10888 //==========================================================================
10889 void ufoEmitWord (uint32_t value) {
10890   ufoImgEmitU8(value & 0xff);
10891   ufoImgEmitU8((value >> 8) & 0xff);
10892 }
10893
10894
10895 //==========================================================================
10896 //
10897 //  ufoEmitCell
10898 //
10899 //==========================================================================
10900 void ufoEmitCell (uint32_t value) {
10901   ufoImgEmitU32(value);
10902 }
10903
10904
10905 //==========================================================================
10906 //
10907 //  ufoIsInited
10908 //
10909 //==========================================================================
10910 int ufoIsInited (void) {
10911   return (ufoMode != UFO_MODE_NONE);
10912 }
10913
10914
10915 //==========================================================================
10916 //
10917 //  ufoSetUserAbort
10918 //
10919 //==========================================================================
10920 void ufoSetUserAbort (void) {
10921   //ufoVMAbort = 1;
10922   //HACK: push "(USER-ABORT)" word to RP
10923   ufoRPush(ufoUserAbortCFA);
10924 }
10925
10926
10927 static void (*ufoUserPostInitCB) (void);
10928
10929
10930 //==========================================================================
10931 //
10932 //  ufoSetUserPostInit
10933 //
10934 //  called after main initialisation
10935 //
10936 //==========================================================================
10937 void ufoSetUserPostInit (void (*cb) (void)) {
10938   ufoUserPostInitCB = cb;
10939 }
10940
10941
10942 //==========================================================================
10943 //
10944 //  ufoSStepAllowed
10945 //
10946 //==========================================================================
10947 int ufoSStepAllowed (void) {
10948   #ifdef UFO_MTASK_ALLOWED
10949   return (ufoSingleStepAllowed != 0);
10950   #else
10951   return 0;
10952   #endif
10953 }
10954
10955
10956 //==========================================================================
10957 //
10958 //  ufoSetSStepAllowed
10959 //
10960 //==========================================================================
10961 void ufoSetSStepAllowed (int enabled) {
10962   #ifdef UFO_MTASK_ALLOWED
10963   ufoSingleStepAllowed = (enabled ? 1 : 0);
10964   #else
10965   (void)enabled;
10966   #endif
10967 }
10968
10969
10970 //==========================================================================
10971 //
10972 //  ufoInit
10973 //
10974 //==========================================================================
10975 void ufoInit (void) {
10976   if (ufoMode != UFO_MODE_NONE) return;
10977   ufoMode = UFO_MODE_NATIVE;
10978
10979   #ifdef UFO_HUGE_IMAGES
10980   memset(ufoImage, 0, sizeof(ufoImage));
10981   #endif
10982
10983   #ifdef UFO_MTASK_ALLOWED
10984   ufoSingleStepAllowed = 0;
10985   #endif
10986
10987   ufoInFileLine = 0;
10988   ufoInFileName = NULL; ufoInFileNameLen = 0; ufoInFileNameHash = 0;
10989   ufoInFile = NULL;
10990   ufoLastIncPath = NULL; ufoLastSysIncPath = NULL;
10991
10992   #ifdef UFO_MTASK_ALLOWED
10993   for (uint32_t f = 0; f < UFO_MAX_STATES; f += 1u) ufoStateMap[f] = NULL;
10994   memset(ufoStateUsedBitmap, 0, sizeof(ufoStateUsedBitmap));
10995   ufoCurrState = ufoNewState();
10996   strcpy(ufoCurrState->name, "MAIN");
10997   ufoInitStateUserVars(ufoCurrState);
10998   #else
10999   memset(&ufoCurrState, 0, sizeof(ufoCurrState));
11000   strcpy(ufoCurrState.name, "MAIN");
11001   ufoInitStateUserVars(&ufoCurrState);
11002   #endif
11003
11004   ufoImgPutU32(ufoAddrDefTIB, 0); // create TIB handle
11005   ufoImgPutU32(ufoAddrTIBx, 0); // create TIB handle
11006
11007   #ifdef UFO_MTASK_ALLOWED
11008   ufoYieldedState = NULL;
11009   ufoDebuggerState = NULL;
11010   ufoSingleStep = 0;
11011   #endif
11012
11013   #ifdef UFO_DEBUG_STARTUP_TIMES
11014   uint32_t stt = ufo_get_msecs();
11015   ufoCondDefine("UFO-DEBUG-STARTUP-TIMES");
11016   #endif
11017   ufoInitCommon();
11018   #ifdef UFO_DEBUG_STARTUP_TIMES
11019   uint32_t ett = ufo_get_msecs();
11020   fprintf(stderr, "UrForth init time: %u msecs\n", (unsigned)(ett - stt));
11021   #endif
11022
11023   ufoReset();
11024
11025   if (ufoUserPostInitCB) {
11026     ufoUserPostInitCB();
11027     ufoReset();
11028   }
11029
11030   // load ufo modules
11031   char *ufmname = ufoCreateIncludeName("init", 1, NULL);
11032   #ifdef WIN32
11033   FILE *ufl = fopen(ufmname, "rb");
11034   #else
11035   FILE *ufl = fopen(ufmname, "r");
11036   #endif
11037   if (ufl) {
11038     ufoPushInFile();
11039     ufoSetInFileNameReuse(ufmname);
11040     ufoInFile = ufl;
11041     ufoFileId = ufoLastUsedFileId;
11042     setLastIncPath(ufoInFileName, 1);
11043   } else {
11044     free(ufmname);
11045     ufoFatal("cannot load init code");
11046   }
11047
11048   if (ufoInFile != NULL) {
11049     ufoRunInterpretLoop();
11050   }
11051 }
11052
11053
11054 //==========================================================================
11055 //
11056 //  ufoFinishVM
11057 //
11058 //==========================================================================
11059 void ufoFinishVM (void) {
11060   if (ufoInRunWord) {
11061     longjmp(ufoStopVMJP, 669);
11062   } else {
11063     ufoFatal("VM is not running");
11064   }
11065 }
11066
11067
11068 //==========================================================================
11069 //
11070 //  ufoCallParseIntr
11071 //
11072 //  ( -- addr count TRUE / FALSE )
11073 //  does base TIB parsing; never copies anything.
11074 //  as our reader is line-based, returns FALSE on EOL.
11075 //  EOL is detected after skipping leading delimiters.
11076 //  passing -1 as delimiter skips the whole line, and always returns FALSE.
11077 //  trailing delimiter is always skipped.
11078 //  result is on the data stack.
11079 //
11080 //==========================================================================
11081 void ufoCallParseIntr (uint32_t delim, int skipLeading) {
11082   ufoPush(delim); ufoPushBool(skipLeading);
11083   UFCALL(PAR_PARSE);
11084 }
11085
11086
11087 //==========================================================================
11088 //
11089 //  ufoCallParseName
11090 //
11091 //  ( -- addr count )
11092 //  parse with leading blanks skipping. doesn't copy anything.
11093 //  return empty string on EOL.
11094 //
11095 //==========================================================================
11096 void ufoCallParseName (void) {
11097   UFCALL(PARSE_NAME);
11098 }
11099
11100
11101 //==========================================================================
11102 //
11103 //  ufoCallParse
11104 //
11105 //  ( -- addr count TRUE / FALSE )
11106 //  parse without skipping delimiters; never copies anything.
11107 //  as our reader is line-based, returns FALSE on EOL.
11108 //  passing 0 as delimiter skips the whole line, and always returns FALSE.
11109 //  trailing delimiter is always skipped.
11110 //
11111 //==========================================================================
11112 void ufoCallParse (uint32_t delim) {
11113   ufoPush(delim);
11114   UFCALL(PARSE);
11115 }
11116
11117
11118 //==========================================================================
11119 //
11120 //  ufoCallParseSkipBlanks
11121 //
11122 //==========================================================================
11123 void ufoCallParseSkipBlanks (void) {
11124   UFCALL(PARSE_SKIP_BLANKS);
11125 }
11126
11127
11128 //==========================================================================
11129 //
11130 //  ufoCallParseSkipComments
11131 //
11132 //==========================================================================
11133 void ufoCallParseSkipComments (void) {
11134   ufoPushBool(1); UFCALL(PAR_PARSE_SKIP_COMMENTS);
11135 }
11136
11137
11138 //==========================================================================
11139 //
11140 //  ufoCallParseSkipLineComments
11141 //
11142 //==========================================================================
11143 void ufoCallParseSkipLineComments (void) {
11144   ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS);
11145 }
11146
11147
11148 //==========================================================================
11149 //
11150 //  ufoCallParseSkipLine
11151 //
11152 //  to the end of line; doesn't refill
11153 //
11154 //==========================================================================
11155 void ufoCallParseSkipLine (void) {
11156   UFCALL(PARSE_SKIP_LINE);
11157 }
11158
11159
11160 //==========================================================================
11161 //
11162 //  ufoCallBasedNumber
11163 //
11164 //  convert number from addrl+1
11165 //  returns address of the first inconvertible char
11166 //  (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
11167 //
11168 //==========================================================================
11169 void ufoCallBasedNumber (uint32_t addr, uint32_t count, int allowSign, int base) {
11170   ufoPush(addr); ufoPush(count); ufoPushBool(allowSign);
11171   if (base < 0) ufoPush(0); else ufoPush((uint32_t)base);
11172   UFCALL(PAR_BASED_NUMBER);
11173 }
11174
11175
11176 //==========================================================================
11177 //
11178 //  ufoRunWord
11179 //
11180 //==========================================================================
11181 void ufoRunWord (uint32_t cfa) {
11182   if (cfa != 0) {
11183     if (ufoMode == UFO_MODE_NONE) ufoFatal("UrForth is not properly inited");
11184     if (ufoInRunWord) ufoFatal("`ufoRunWord` cannot be called recursively");
11185     ufoMode = UFO_MODE_NATIVE;
11186     ufoRunVMCFA(cfa);
11187   }
11188 }
11189
11190
11191 //==========================================================================
11192 //
11193 //  ufoRunMacroWord
11194 //
11195 //==========================================================================
11196 void ufoRunMacroWord (uint32_t cfa) {
11197   if (cfa != 0) {
11198     if (ufoMode == UFO_MODE_NONE) ufoFatal("UrForth is not properly inited");
11199     if (ufoInRunWord) ufoFatal("`ufoRunWord` cannot be called recursively");
11200     ufoMode = UFO_MODE_MACRO;
11201     const uint32_t oisp = ufoFileStackPos;
11202     ufoPushInFile();
11203     ufoFileId = 0;
11204     (void)ufoLoadNextUserLine();
11205     ufoRunVMCFA(cfa);
11206     ufoPopInFile();
11207     ufo_assert(ufoFileStackPos == oisp); // sanity check
11208   }
11209 }
11210
11211
11212 //==========================================================================
11213 //
11214 //  ufoIsInMacroMode
11215 //
11216 //  check if we are currently in "MACRO" mode.
11217 //  should be called from registered words.
11218 //
11219 //==========================================================================
11220 int ufoIsInMacroMode (void) {
11221   return (ufoMode == UFO_MODE_MACRO);
11222 }
11223
11224
11225 //==========================================================================
11226 //
11227 //  ufoRunInterpretLoop
11228 //
11229 //  run default interpret loop.
11230 //
11231 //==========================================================================
11232 void ufoRunInterpretLoop (void) {
11233   if (ufoMode == UFO_MODE_NONE) {
11234     ufoInit();
11235   }
11236   const uint32_t cfa = ufoFindWord("RUN-INTERPRET-LOOP");
11237   if (cfa == 0) ufoFatal("'RUN-INTERPRET-LOOP' word not found");
11238   ufoReset();
11239   ufoMode = UFO_MODE_NATIVE;
11240   ufoRunVMCFA(cfa);
11241   while (ufoFileStackPos != 0) ufoPopInFile();
11242 }
11243
11244
11245 //==========================================================================
11246 //
11247 //  ufoRunFile
11248 //
11249 //==========================================================================
11250 void ufoRunFile (const char *fname) {
11251   if (ufoMode == UFO_MODE_NONE) {
11252     ufoInit();
11253   }
11254   if (ufoInRunWord) ufoFatal("`ufoRunFile` cannot be called recursively");
11255   ufoMode = UFO_MODE_NATIVE;
11256
11257   ufoReset();
11258   char *ufmname = ufoCreateIncludeName(fname, 0, ".");
11259   #ifdef WIN32
11260   FILE *ufl = fopen(ufmname, "rb");
11261   #else
11262   FILE *ufl = fopen(ufmname, "r");
11263   #endif
11264   if (ufl) {
11265     ufoPushInFile();
11266     ufoSetInFileNameReuse(ufmname);
11267     ufoInFile = ufl;
11268     ufoFileId = ufoLastUsedFileId;
11269     setLastIncPath(ufoInFileName, 0);
11270   } else {
11271     free(ufmname);
11272     ufoFatal("cannot load source file '%s'", fname);
11273   }
11274   ufoRunInterpretLoop();
11275 }
11276
11277
11278 //==========================================================================
11279 //
11280 //  ufoIsMTaskEnabled
11281 //
11282 //  check if the system was compiled with multitasking support
11283 //
11284 //==========================================================================
11285 int ufoIsMTaskEnabled (void) {
11286   #ifdef UFO_MTASK_ALLOWED
11287   return 1;
11288   #else
11289   return 0;
11290   #endif
11291 }