1 // and now for something completely different...
2 // UrAsm built-in Forth Engine!
15 #include <sys/fcntl.h>
17 #include <sys/types.h>
22 # define realpath(shit,fuck) _fullpath(fuck, shit, 32768)
25 // if defined, UFO will allocate 64MB main image, and 4MB temp image immediately
26 #define UFO_HUGE_IMAGES
28 // use relative branch addresses for position-independent code?
29 #define UFO_RELATIVE_BRANCH
31 // if defined, multitasking engine is allowed.
32 // multitasker is currently used only for debugger.
33 //#define UFO_MTASK_ALLOWED
36 //#define UFO_DEBUG_WRITE_MAIN_IMAGE
37 //#define UFO_DEBUG_WRITE_DEBUG_IMAGE
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
51 // 2/8 msecs w/o inlining
52 // 1/5 msecs with inlining
54 # define UFO_FORCE_INLINE static inline __attribute__((always_inline))
56 # define UFO_FORCE_INLINE static __attribute__((noinline)) /*__attribute__((unused))*/
58 #define UFO_DISABLE_INLINE static __attribute__((noinline)) /*__attribute__((unused))*/
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
66 // should not be bigger than this!
67 #define UFO_MAX_WORD_LENGTH (250)
69 //#define UFO_ALIGN4(v_) (((v_) + 3u) / 4u * 4u)
70 #define UFO_ALIGN4(v_) (((v_) + 3u) & ~(uint32_t)3)
73 // ////////////////////////////////////////////////////////////////////////// //
74 static void ufoFlushOutput (void);
76 UFO_DISABLE_INLINE
const char *ufo_assert_failure (const char *cond
, const char *fname
,
77 int fline
, const char *func
)
79 for (const char *t
= fname
; *t
; ++t
) {
81 if (*t
== '/' || *t
== '\\') fname
= t
+1;
83 if (*t
== '/') fname
= t
+1;
87 fprintf(stderr
, "\n%s:%d: Assertion in `%s` failed: %s\n", fname
, fline
, func
, cond
);
92 #define ufo_assert(cond_) do { if (__builtin_expect((!(cond_)), 0)) { ufo_assert_failure(#cond_, __FILE__, __LINE__, __PRETTY_FUNCTION__); } } while (0)
95 static char ufoRealPathBuf
[32769];
96 static char ufoRealPathHashBuf
[32769];
99 //==========================================================================
103 //==========================================================================
104 static char *ufoRealPath (const char *fname
) {
106 if (fname
!= NULL
&& fname
[0] != 0) {
107 res
= realpath(fname
, NULL
);
109 const size_t slen
= strlen(res
);
111 strcpy(ufoRealPathBuf
, res
);
113 res
= ufoRealPathBuf
;
127 static time_t secstart
= 0;
132 //==========================================================================
136 //==========================================================================
137 static uint64_t ufo_get_msecs (void) {
139 return GetTickCount();
142 #ifdef CLOCK_MONOTONIC
143 ufo_assert(clock_gettime(CLOCK_MONOTONIC
, &ts
) == 0);
145 // this should be available everywhere
146 ufo_assert(clock_gettime(CLOCK_REALTIME
, &ts
) == 0);
150 secstart
= ts
.tv_sec
+1;
151 ufo_assert(secstart
); // it should not be zero
153 return (uint64_t)(ts
.tv_sec
-secstart
+2)*1000U+(uint32_t)ts
.tv_nsec
/1000000U;
155 //return (uint64_t)(ts.tv_sec-secstart+2)*1000000000U+(uint32_t)ts.tv_nsec;
160 //==========================================================================
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
;
169 hash
+= (*s
++)|orbyte
;
181 // this converts ASCII capitals to locase (and destroys other, but who cares)
182 #define joaatHashBufCI(buf_,len_) joaatHashBuf((buf_), (len_), 0x20)
185 //==========================================================================
189 //==========================================================================
190 UFO_FORCE_INLINE
char toUpper (char ch
) {
191 return (ch
>= 'a' && ch
<= 'z' ? ch
-'a'+'A' : ch
);
195 //==========================================================================
199 //==========================================================================
200 UFO_FORCE_INLINE
uint8_t toUpperU8 (uint8_t ch
) {
201 return (ch
>= 'a' && ch
<= 'z' ? ch
-'a'+'A' : ch
);
205 //==========================================================================
209 //==========================================================================
210 UFO_FORCE_INLINE
int digitInBase (char ch
, int base
) {
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;
217 return (ch
>= 0 && ch
< base
? ch
: -1);
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
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
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
243 ;; dd cfaidx ; our internal CFA index, or image address for DOES>
244 ;; dd ? ; reserved for "does"
248 ;; first word cell contains combined name length (low byte), argtype and flags (other bytes)
253 ;; i.e. we have 16 bits for flags, and 256 possible argument types. why not.
262 ;; bit 6: *UNUSED* main scattered colon word (with "...")
264 ;; bit 8: conditional branch (has sense only for words with branch address)
265 ;; bit 9: may return, but may not (unreliable flag ;-)
267 ;; argtype is the type of the argument that this word reads from the threaded code.
268 ;; possible argument types:
271 ;; 2: cell-size numeric literal
272 ;; 3: cell-counted string with terminating zero (not counted)
273 ;; 4: cfa of another word
276 ;; 7: byte-counted string with terminating zero (not counted)
277 ;; 8: data skip: the arg is amout of bytes to skip (not including the counter itself)
281 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
282 ;; wordlist structure (at PFA)
283 ;; -4: wordlist type id (used by structs, for example)
285 ;; dd voclink (voclink always points here)
286 ;; dd parent (if not zero, all parent words are visible)
287 ;; dd header-nfa (can be 0 for anonymous wordlists)
288 ;; hashtable (if enabled), or ~0U if no hash table
292 // ////////////////////////////////////////////////////////////////////////// //
293 #define UFO_BFA_TO_LFA(bfa_) ((bfa_) + 1u * 4u)
294 #define UFO_LFA_TO_XFA(lfa_) ((lfa_) - 3u * 4u)
295 #define UFO_LFA_TO_YFA(lfa_) ((lfa_) - 2u * 4u)
296 #define UFO_LFA_TO_BFA(lfa_) ((lfa_) - 1u * 4u)
297 #define UFO_LFA_TO_NFA(lfa_) ((lfa_) + 2u * 4u)
298 #define UFO_LFA_TO_CFA(lfa_) UFO_ALIGN4((lfa_) + 3u * 4u + 1u + ufoImgGetU8((lfa_) + 2u * 4u))
299 #define UFO_LFA_TO_NHASH(lfa_) ((lfa_) + 1u * 4u)
300 #define UFO_CFA_TO_NFA(cfa_) ((cfa_) - 1u - 4u - ufoImgGetU8((cfa_) - 1u))
301 #define UFO_CFA_TO_LFA(cfa_) ((cfa_) - 1u - 4u * 3u - ufoImgGetU8((cfa_) - 1u))
302 #define UFO_CFA_TO_PFA(cfa_) ((cfa_) + 2u * 4u)
303 #define UFO_PFA_TO_CFA(pfa_) ((pfa_) - 2u * 4u)
304 #define UFO_NFA_TO_CFA(nfa_) UFO_ALIGN4((nfa_) + 4u + 1u + ufoImgGetU8((nfa_)))
305 #define UFO_NFA_TO_LFA(nfa_) ((nfa_) - 2u * 4u)
306 #define UFO_XFA_TO_YFA(xfa_) ((xfa_) + 4u)
307 #define UFO_YFA_TO_XFA(yfa_) ((xfa_) - 4u)
308 #define UFO_YFA_TO_WST(yfa_) ((yfa_) - 4u) /* to xfa */
309 #define UFO_YFA_TO_NFA(yfa_) ((yfa_) + 4u * 4u)
311 #define UFO_CFA_TO_DOES_CFA(cfa_) ((cfa_) + 4u)
312 #define UFO_PFA_TO_DOES_CFA(pfa_) ((pfa_) - 4u)
315 // ////////////////////////////////////////////////////////////////////////// //
316 #define UFW_VOCAB_OFS_LATEST (0u * 4u)
317 #define UFW_VOCAB_OFS_VOCLINK (1u * 4u)
318 #define UFW_VOCAB_OFS_PARENT (2u * 4u)
319 #define UFW_VOCAB_OFS_HEADER (3u * 4u)
320 #define UFW_VOCAB_OFS_HTABLE (4u * 4u)
322 #define UFO_HASHTABLE_SIZE (256)
324 #define UFO_NO_HTABLE_FLAG (~(uint32_t)0)
326 #define UFO_MAX_NATIVE_CFAS (1024u)
327 static ufoNativeCFA ufoForthCFAs
[UFO_MAX_NATIVE_CFAS
];
328 static uint32_t ufoCFAsUsed
= 0;
330 static uint32_t ufoDoForthCFA
;
331 static uint32_t ufoDoVariableCFA
;
332 static uint32_t ufoDoValueCFA
;
333 static uint32_t ufoDoConstCFA
;
334 static uint32_t ufoDoDeferCFA
;
335 static uint32_t ufoDoDoesCFA
;
336 static uint32_t ufoDoRedirectCFA
;
337 static uint32_t ufoDoVocCFA
;
338 static uint32_t ufoDoCreateCFA
;
339 static uint32_t ufoDoUserVariableCFA
;
341 static uint32_t ufoLitStr8CFA
;
343 #ifdef UFO_MTASK_ALLOWED
344 static uint32_t ufoSingleStepAllowed
;
347 // special address types:
348 #define UFO_ADDR_CFA_BIT ((uint32_t)1<<31)
349 #define UFO_ADDR_CFA_MASK (UFO_ADDR_CFA_BIT-1u)
351 // handles are somewhat special: first 12 bits can be used as offset for "@", and are ignored
352 #define UFO_ADDR_HANDLE_BIT ((uint32_t)1<<30)
353 #define UFO_ADDR_HANDLE_MASK ((UFO_ADDR_HANDLE_BIT-1u)&~((uint32_t)0xfff))
354 #define UFO_ADDR_HANDLE_SHIFT (12)
355 #define UFO_ADDR_HANDLE_OFS_MASK ((uint32_t)((1 << UFO_ADDR_HANDLE_SHIFT) - 1))
357 // temporary area is 1MB buffer out of the main image
358 #define UFO_ADDR_TEMP_BIT ((uint32_t)1<<29)
359 #define UFO_ADDR_TEMP_MASK (UFO_ADDR_TEMP_BIT-1u)
361 #define UFO_ADDR_SPECIAL_BITS_MASK (UFO_ADDR_CFA_BIT|UFO_ADDR_HANDLE_BIT|UFO_ADDR_TEMP_BIT)
364 #ifdef UFO_HUGE_IMAGES
365 #define ufoImageSize (1024u * 1024u * 64u)
366 static uint32_t ufoImage
[ufoImageSize
/ 4u];
368 static uint32_t *ufoImage
= NULL
;
369 static uint32_t ufoImageSize
= 0;
372 static uint8_t *ufoDebugImage
= NULL
;
373 static uint32_t ufoDebugImageUsed
= 0; // in bytes
374 static uint32_t ufoDebugImageSize
= 0; // in bytes
375 static uint32_t ufoDebugFileNameHash
= 0; // current file name hash
376 static uint32_t ufoDebugFileNameLen
= 0; // current file name length
377 static uint32_t ufoDebugLastLine
= 0;
378 static uint32_t ufoDebugLastLinePCOfs
= 0;
379 static uint32_t ufoDebugLastLineDP
= 0;
380 static uint32_t ufoDebugCurrDP
= 0;
382 static uint32_t ufoInRunWord
= 0;
384 //static volatile int ufoVMAbort = 0;
386 #define ufoTrueValue (~(uint32_t)0)
390 UFO_MODE_NATIVE
= 0, // executing forth code
391 UFO_MODE_MACRO
= 1, // executing forth asm macro
393 static uint32_t ufoMode
= UFO_MODE_NONE
;
395 #define UFO_DSTACK_SIZE (8192)
396 #define UFO_RSTACK_SIZE (4096)
397 #define UFO_LSTACK_SIZE (4096)
398 #define UFO_MAX_TASK_NAME (127)
399 #define UFO_VOCSTACK_SIZE (16u)
401 #define UFO_MAX_TEMP_IMAGE (1024u * 1024u * 8u)
403 // to support multitasking (required for the debugger),
404 // our virtual machine state is encapsulated in a struct.
405 typedef struct UfoState_t
{
407 uint32_t dStack
[UFO_DSTACK_SIZE
];
408 uint32_t rStack
[UFO_RSTACK_SIZE
];
409 uint32_t lStack
[UFO_LSTACK_SIZE
];
410 uint32_t IP
; // in image
411 uint32_t SP
; // points AFTER the last value pushed
412 uint32_t RP
; // points AFTER the last value pushed
419 uint32_t vocStack
[UFO_VOCSTACK_SIZE
]; // cfas
422 #ifdef UFO_HUGE_IMAGES
423 uint32_t imageTemp
[UFO_MAX_TEMP_IMAGE
/ 4u];
426 uint32_t imageTempSize
;
428 // linked list of all allocated states (tasks)
429 char name
[UFO_MAX_TASK_NAME
+ 1];
433 #define UFO_MAX_STATES (8192)
435 #ifdef UFO_MTASK_ALLOWED
436 // this is indexed by id
437 static UfoState
*ufoStateMap
[UFO_MAX_STATES
] = {NULL
};
438 static uint32_t ufoStateUsedBitmap
[UFO_MAX_STATES
/32] = {0};
440 // currently active execution state
441 static UfoState
*ufoCurrState
= NULL
;
442 // state we're yielded from
443 static UfoState
*ufoYieldedState
= NULL
;
444 // if debug state is not NULL, VM will switch to it
445 // after executing one instruction from the current state.
446 // it will store current state in `ufoDebugeeState`.
447 static UfoState
*ufoDebuggerState
= NULL
;
448 static uint32_t ufoSingleStep
= 0;
450 #define ufoDStack (ufoCurrState->dStack)
451 #define ufoRStack (ufoCurrState->rStack)
452 #define ufoLStack (ufoCurrState->lStack)
453 #define ufoIP (ufoCurrState->IP)
454 #define ufoSP (ufoCurrState->SP)
455 #define ufoRP (ufoCurrState->RP)
456 #define ufoLP (ufoCurrState->LP)
457 #define ufoLBP (ufoCurrState->LBP)
458 #define ufoRegA (ufoCurrState->regA)
459 #define ufoImageTemp (ufoCurrState->imageTemp)
460 #ifdef UFO_HUGE_IMAGES
461 # define ufoImageTempSize UFO_MAX_TEMP_IMAGE
462 # define ufoSTImageTempSize(st_) UFO_MAX_TEMP_IMAGE
464 # define ufoImageTempSize (ufoCurrState->imageTempSize)
465 # define ufoSTImageTempSize(st_) ((st_)->imageTempSize)
467 #define ufoVocStack (ufoCurrState->vocStack)
468 #define ufoVSP (ufoCurrState->VSP)
470 #else /* no multitasking */
472 static UfoState ufoCurrState
;
474 #define ufoDStack (ufoCurrState.dStack)
475 #define ufoRStack (ufoCurrState.rStack)
476 #define ufoLStack (ufoCurrState.lStack)
477 #define ufoIP (ufoCurrState.IP)
478 #define ufoSP (ufoCurrState.SP)
479 #define ufoRP (ufoCurrState.RP)
480 #define ufoLP (ufoCurrState.LP)
481 #define ufoLBP (ufoCurrState.LBP)
482 #define ufoRegA (ufoCurrState.regA)
483 #define ufoImageTemp (ufoCurrState.imageTemp)
484 #ifdef UFO_HUGE_IMAGES
485 # define ufoImageTempSize UFO_MAX_TEMP_IMAGE
486 # define ufoSTImageTempSize(st_) UFO_MAX_TEMP_IMAGE
488 # define ufoImageTempSize (ufoCurrState.imageTempSize)
489 # define ufoSTImageTempSize(st_) ((st_)->imageTempSize)
491 #define ufoVocStack (ufoCurrState.vocStack)
492 #define ufoVSP (ufoCurrState.VSP)
496 static jmp_buf ufoStopVMJP
;
498 // 256 bytes for user variables
499 #define UFO_USER_AREA_ADDR UFO_ADDR_TEMP_BIT
500 #define UFO_USER_AREA_SIZE (256u)
501 #define UFO_NBUF_ADDR UFO_USER_AREA_ADDR + UFO_USER_AREA_SIZE
502 #define UFO_NBUF_SIZE (256u)
503 #define UFO_PAD_ADDR (UFO_NBUF_ADDR + UFO_NBUF_SIZE)
504 #define UFO_DEF_TIB_ADDR (UFO_PAD_ADDR + 2048u)
506 // dynamically allocated text input buffer
507 // always ends with zero (this is word name too)
508 static const uint32_t ufoAddrTIBx
= UFO_ADDR_TEMP_BIT
+ 0u * 4u; // TIB
509 static const uint32_t ufoAddrINx
= UFO_ADDR_TEMP_BIT
+ 1u * 4u; // >IN
510 static const uint32_t ufoAddrDefTIB
= UFO_ADDR_TEMP_BIT
+ 2u * 4u; // default TIB (handle); user cannot change it
511 static const uint32_t ufoAddrBASE
= UFO_ADDR_TEMP_BIT
+ 3u * 4u;
512 static const uint32_t ufoAddrSTATE
= UFO_ADDR_TEMP_BIT
+ 4u * 4u;
513 static const uint32_t ufoAddrContext
= UFO_ADDR_TEMP_BIT
+ 5u * 4u; // CONTEXT
514 static const uint32_t ufoAddrCurrent
= UFO_ADDR_TEMP_BIT
+ 6u * 4u; // CURRENT (definitions will go there)
515 static const uint32_t ufoAddrSelf
= UFO_ADDR_TEMP_BIT
+ 7u * 4u; // CURRENT (definitions will go there)
516 static const uint32_t ufoAddrInterNextLine
= UFO_ADDR_TEMP_BIT
+ 8u * 4u; // (INTERPRET-NEXT-LINE)
517 static const uint32_t ufoAddrEP
= UFO_ADDR_TEMP_BIT
+ 9u * 4u; // (EP) -- exception frame pointer
518 static const uint32_t ufoAddrDPTemp
= UFO_ADDR_TEMP_BIT
+ 10u * 4u; // pointer to currently active DP in temp dict
519 static const uint32_t ufoAddrHereDP
= UFO_ADDR_TEMP_BIT
+ 11u * 4u; // pointer to currently active DP for HERE
520 static const uint32_t ufoAddrUserVarUsed
= UFO_ADDR_TEMP_BIT
+ 12u * 4u;
522 #define UFO_DPTEMP_BASE_ADDR (UFO_ADDR_TEMP_BIT + 256u * 1024u)
524 static uint32_t ufoAddrVocLink
;
525 static uint32_t ufoAddrDP
; // DP for main dict
526 static uint32_t ufoAddrNewWordFlags
;
527 static uint32_t ufoAddrRedefineWarning
;
528 static uint32_t ufoAddrLastXFA
;
530 static uint32_t ufoForthVocId
;
531 static uint32_t ufoCompilerVocId
;
532 static uint32_t ufoInterpNextLineCFA
;
534 static uint32_t ufoUserAbortCFA
;
536 // allows to redefine even protected words
537 #define UFO_REDEF_WARN_DONT_CARE (~(uint32_t)0)
538 // do not warn about ordinary words, allow others
539 #define UFO_REDEF_WARN_NONE (0)
540 // do warn (or fail on protected)
541 #define UFO_REDEF_WARN_NORMAL (1)
542 // do warn (or fail on protected) for parent dicts too
543 #define UFO_REDEF_WARN_PARENTS (2)
545 #define UFO_GET_DP() (ufoImgGetU32(ufoImgGetU32(ufoAddrHereDP)))
547 #define UFO_MAX_NESTED_INCLUDES (32)
554 uint32_t id
; // non-zero unique id
557 static UFOFileStackEntry ufoFileStack
[UFO_MAX_NESTED_INCLUDES
];
558 static uint32_t ufoFileStackPos
; // after the last used item
560 static FILE *ufoInFile
= NULL
;
561 static uint32_t ufoInFileNameLen
= 0;
562 static uint32_t ufoInFileNameHash
= 0;
563 static char *ufoInFileName
= NULL
;
564 static char *ufoLastIncPath
= NULL
;
565 static char *ufoLastSysIncPath
= NULL
;
566 static int ufoInFileLine
= 0;
567 static uint32_t ufoFileId
= 0;
568 static uint32_t ufoLastUsedFileId
= 0;
569 static int ufoLastEmitWasCR
= 1;
570 static long ufoCurrIncludeLineFileOfs
= 0;
572 // dynamic memory handles
573 typedef struct UHandleInfo_t
{
580 struct UHandleInfo_t
*next
;
583 static UfoHandle
*ufoHandleFreeList
= NULL
;
584 static UfoHandle
**ufoHandles
= NULL
;
585 static uint32_t ufoHandlesUsed
= 0;
586 static uint32_t ufoHandlesAlloted
= 0;
588 #define UFO_HANDLE_FREE (~(uint32_t)0)
590 static char ufoCurrFileLine
[520];
593 static uint32_t ufoInBacktrace
= 0;
596 // ////////////////////////////////////////////////////////////////////////// //
597 static void ufoClearCondDefines (void);
599 static void ufoBacktrace (uint32_t ip
, int showDataStack
);
600 static void ufoBTShowWordName (uint32_t nfa
);
602 static void ufoClearCondDefines (void);
604 #ifdef UFO_MTASK_ALLOWED
605 static UfoState
*ufoNewState (void);
606 static void ufoFreeState (UfoState
*st
);
607 static UfoState
*ufoFindState (uint32_t stid
);
608 static void ufoSwitchToState (UfoState
*newst
);
610 static void ufoInitStateUserVars (UfoState
*st
);
612 __attribute__((unused
)) static void ufoDumpWordHeader (const uint32_t lfa
);
615 static void ufoDisableRaw (void);
617 static void ufoTTYRawFlush (void);
618 static int ufoIsGoodTTY (void);
620 #ifdef UFO_DEBUG_DEBUG
621 static void ufoDumpDebugImage (void);
625 // ////////////////////////////////////////////////////////////////////////// //
626 #ifdef UFO_MTASK_ALLOWED
627 #define UFO_EXEC_CFA(cfa_) do { \
628 const uint32_t cfa = (cfa_); \
629 if (ufoCurrState == NULL) ufoFatal("execution state is lost"); \
630 const uint32_t cfaidx = ufoImgGetU32(cfa); \
631 if (cfaidx >= UFO_ADDR_CFA_BIT && cfaidx < UFO_MAX_NATIVE_CFAS + UFO_ADDR_CFA_BIT) { \
632 ufoForthCFAs[cfaidx & UFO_ADDR_CFA_MASK](UFO_CFA_TO_PFA(cfa)); \
634 ufoFatal("tried to execute an unknown word: %u (max is %u); IP=%u", cfaidx, ufoCFAsUsed, ufoIP - 4u); \
636 /* that's all we need to activate the debugger */ \
637 if (ufoSingleStep) { \
638 ufoSingleStep -= 1; \
639 if (ufoSingleStep == 0 && ufoDebuggerState != NULL) { \
640 if (ufoCurrState == ufoDebuggerState) ufoFatal("debugger cannot debug itself"); \
641 UfoState *ost = ufoCurrState; \
642 ufoSwitchToState(ufoDebuggerState); /* always use API call for this! */ \
652 # define UFO_EXEC_CFA_DEBUG do { \
653 fprintf(stderr, "IP:%08X CFA:%08X (CFA):%08X\n", ufoIP, xxcfa, xxcfaidx); \
654 uint32_t nfa = ufoFindWordForIP(ufoIP - 4u); \
656 fprintf(stderr, " IP: "); ufoBTShowWordName(nfa); \
657 /*fname = ufoFindFileForIP(ip, &fline, NULL, NULL);*/ \
658 /*if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }*/ \
659 fputc('\n', stderr); \
661 nfa = ufoFindWordForIP(xxcfa); \
663 fprintf(stderr, " CFA:"); ufoBTShowWordName(nfa); \
664 /*fname = ufoFindFileForIP(ip, &fline, NULL, NULL);*/ \
665 /*if (fname != NULL) { fprintf(stderr, " (at %s:%u)", fname, fline); }*/ \
666 fputc('\n', stderr); \
670 # define UFO_EXEC_CFA_DEBUG
673 #define UFO_EXEC_CFA(cfa__) do { \
674 const uint32_t xxcfa = (cfa__); \
675 const uint32_t xxcfaidx = ufoImgGetU32(xxcfa); \
677 if (xxcfaidx >= UFO_ADDR_CFA_BIT && xxcfaidx < UFO_MAX_NATIVE_CFAS + UFO_ADDR_CFA_BIT) { \
678 ufoForthCFAs[xxcfaidx & UFO_ADDR_CFA_MASK](UFO_CFA_TO_PFA(xxcfa)); \
680 ufoFatal("tried to execute an unknown word: %u (max is %u); IP=%u; CFA=%u", \
681 xxcfaidx, ufoCFAsUsed, ufoIP - 4u, xxcfa); \
688 // ////////////////////////////////////////////////////////////////////////// //
689 #define UFWORD(name_) \
690 static void ufoWord_##name_ (uint32_t mypfa)
692 #define UFCALL(name_) ufoWord_##name_(0)
693 #define UFCFA(name_) (&ufoWord_##name_)
696 UFWORD(CPOKE_REGA_IDX
);
699 UFWORD(PAR_HANDLE_LOAD_BYTE
);
700 UFWORD(PAR_HANDLE_LOAD_WORD
);
701 UFWORD(PAR_HANDLE_LOAD_CELL
);
702 UFWORD(PAR_HANDLE_STORE_BYTE
);
703 UFWORD(PAR_HANDLE_STORE_WORD
);
704 UFWORD(PAR_HANDLE_STORE_CELL
);
707 //==========================================================================
711 //==========================================================================
712 static void ufoFlushOutput (void) {
718 //==========================================================================
722 // if `reuse` is not 0, reuse/free `fname`
724 //==========================================================================
725 static void ufoSetInFileNameEx (const char *fname
, int reuse
) {
726 ufo_assert(fname
== NULL
|| (fname
!= ufoInFileName
));
727 if (fname
== NULL
|| fname
[0] == 0) {
728 if (ufoInFileName
) { free(ufoInFileName
); ufoInFileName
= NULL
; }
729 ufoInFileNameLen
= 0;
730 ufoInFileNameHash
= 0;
731 if (reuse
&& fname
!= NULL
) free((void *)fname
);
733 const uint32_t fnlen
= (uint32_t)strlen(fname
);
734 const uint32_t fnhash
= joaatHashBuf(fname
, fnlen
, 0);
735 if (ufoInFileNameLen
!= fnlen
|| ufoInFileNameHash
!= fnhash
) {
736 if (ufoInFileName
) { free(ufoInFileName
); ufoInFileName
= NULL
; }
738 ufoInFileName
= (char *)fname
;
740 ufoInFileName
= strdup(fname
);
741 if (ufoInFileName
== NULL
) ufoFatal("out of memory for filename info");
743 ufoInFileNameLen
= fnlen
;
744 ufoInFileNameHash
= fnhash
;
746 if (reuse
&& fname
!= NULL
) free((void *)fname
);
752 //==========================================================================
756 //==========================================================================
757 UFO_FORCE_INLINE
void ufoSetInFileName (const char *fname
) {
758 ufoSetInFileNameEx(fname
, 0);
762 //==========================================================================
764 // ufoSetInFileNameReuse
766 //==========================================================================
767 UFO_FORCE_INLINE
void ufoSetInFileNameReuse (const char *fname
) {
768 ufoSetInFileNameEx(fname
, 1);
772 //==========================================================================
776 //==========================================================================
777 static UfoHandle
*ufoAllocHandle (uint32_t typeid) {
778 ufo_assert(typeid != UFO_HANDLE_FREE
);
779 UfoHandle
*newh
= ufoHandleFreeList
;
781 if (ufoHandlesUsed
== ufoHandlesAlloted
) {
782 uint32_t newsz
= ufoHandlesAlloted
+ 16384;
783 // due to offsets, this is the maximum number of handles we can have
784 if (newsz
> 0x1ffffU
) {
785 if (ufoHandlesAlloted
> 0x1ffffU
) ufoFatal("too many dynamic handles");
786 newsz
= 0x1ffffU
+ 1U;
787 ufo_assert(newsz
> ufoHandlesAlloted
);
789 UfoHandle
**nh
= realloc(ufoHandles
, sizeof(ufoHandles
[0]) * newsz
);
790 if (nh
== NULL
) ufoFatal("out of memory for handle table");
792 ufoHandlesAlloted
= newsz
;
794 newh
= calloc(1, sizeof(UfoHandle
));
795 if (newh
== NULL
) ufoFatal("out of memory for handle info");
796 ufoHandles
[ufoHandlesUsed
] = newh
;
797 // setup new handle info
798 newh
->ufoHandle
= (ufoHandlesUsed
<< UFO_ADDR_HANDLE_SHIFT
) | UFO_ADDR_HANDLE_BIT
;
801 ufo_assert(newh
->typeid == UFO_HANDLE_FREE
);
802 ufoHandleFreeList
= newh
->next
;
804 // setup new handle info
805 newh
->typeid = typeid;
814 //==========================================================================
818 //==========================================================================
819 static void ufoFreeHandle (UfoHandle
*hh
) {
821 ufo_assert(hh
->typeid != UFO_HANDLE_FREE
);
822 if (hh
->data
) free(hh
->data
);
823 hh
->typeid = UFO_HANDLE_FREE
;
827 hh
->next
= ufoHandleFreeList
;
828 ufoHandleFreeList
= hh
;
833 //==========================================================================
837 //==========================================================================
838 static UfoHandle
*ufoGetHandle (uint32_t hh
) {
840 if (hh
!= 0 && (hh
& UFO_ADDR_HANDLE_BIT
) != 0) {
841 hh
= (hh
& UFO_ADDR_HANDLE_MASK
) >> UFO_ADDR_HANDLE_SHIFT
;
842 if (hh
< ufoHandlesUsed
) {
843 res
= ufoHandles
[hh
];
844 if (res
->typeid == UFO_HANDLE_FREE
) res
= NULL
;
855 #define POP_PREPARE_HANDLE_XX() \
856 if ((hx & UFO_ADDR_HANDLE_BIT) == 0) ufoFatal("not a handle"); \
857 if (idx > 0x1fffffffU - UFO_ADDR_HANDLE_OFS_MASK) ufoFatal("handle index %u out of range", idx); \
858 idx += (hx & UFO_ADDR_HANDLE_OFS_MASK); \
859 UfoHandle *hh = ufoGetHandle(hx); \
860 if (hh == NULL) ufoFatal("invalid handle")
862 UFO_DISABLE_INLINE
uint32_t ufoHandleLoadByte (uint32_t hx
, uint32_t idx
) {
863 POP_PREPARE_HANDLE_XX();
864 if (idx
>= hh
->size
) ufoFatal("handle index %u out of range (%u)", idx
, hh
->size
);
865 return hh
->data
[idx
];
868 UFO_DISABLE_INLINE
uint32_t ufoHandleLoadWord (uint32_t hx
, uint32_t idx
) {
869 POP_PREPARE_HANDLE_XX();
870 if (idx
>= hh
->size
|| hh
->size
- idx
< 2u) {
871 ufoFatal("handle index %u out of range (%u)", idx
, hh
->size
);
873 #ifdef UFO_FAST_MEM_ACCESS
874 return *(const uint16_t *)(hh
->data
+ idx
);
876 uint32_t res
= hh
->data
[idx
];
877 res
|= hh
->data
[idx
+ 1u] << 8;
882 UFO_DISABLE_INLINE
uint32_t ufoHandleLoadCell (uint32_t hx
, uint32_t idx
) {
883 POP_PREPARE_HANDLE_XX();
884 if (idx
>= hh
->size
|| hh
->size
- idx
< 4u) {
885 ufoFatal("handle index %u out of range (%u)", idx
, hh
->size
);
887 #ifdef UFO_FAST_MEM_ACCESS
888 return *(const uint32_t *)(hh
->data
+ idx
);
890 uint32_t res
= hh
->data
[idx
];
891 res
|= hh
->data
[idx
+ 1u] << 8;
892 res
|= hh
->data
[idx
+ 2u] << 16;
893 res
|= hh
->data
[idx
+ 3u] << 24;
898 UFO_DISABLE_INLINE
void ufoHandleStoreByte (uint32_t hx
, uint32_t idx
, uint32_t value
) {
899 POP_PREPARE_HANDLE_XX();
900 if (idx
>= hh
->size
) ufoFatal("handle index %u out of range (%u)", idx
, hh
->size
);
901 hh
->data
[idx
] = (uint8_t)value
;
904 UFO_DISABLE_INLINE
void ufoHandleStoreWord (uint32_t hx
, uint32_t idx
, uint32_t value
) {
905 POP_PREPARE_HANDLE_XX();
906 if (idx
>= hh
->size
|| hh
->size
- idx
< 2u) {
907 ufoFatal("handle index %u out of range (%u)", idx
, hh
->size
);
909 #ifdef UFO_FAST_MEM_ACCESS
910 *(uint16_t *)(hh
->data
+ idx
) = (uint16_t)value
;
912 hh
->data
[idx
] = (uint8_t)value
;
913 hh
->data
[idx
+ 1u] = (uint8_t)(value
>> 8);
917 UFO_DISABLE_INLINE
void ufoHandleStoreCell (uint32_t hx
, uint32_t idx
, uint32_t value
) {
918 POP_PREPARE_HANDLE_XX();
919 if (idx
>= hh
->size
|| hh
->size
- idx
< 4u) {
920 ufoFatal("handle index %u out of range (%u)", idx
, hh
->size
);
922 #ifdef UFO_FAST_MEM_ACCESS
923 *(uint32_t *)(hh
->data
+ idx
) = value
;
925 hh
->data
[idx
] = (uint8_t)value
;
926 hh
->data
[idx
+ 1u] = (uint8_t)(value
>> 8);
927 hh
->data
[idx
+ 2u] = (uint8_t)(value
>> 16);
928 hh
->data
[idx
+ 3u] = (uint8_t)(value
>> 24);
933 //==========================================================================
937 //==========================================================================
938 static void setLastIncPath (const char *fname
, int system
) {
939 if (fname
== NULL
|| fname
[0] == 0) {
941 if (ufoLastSysIncPath
) free(ufoLastIncPath
);
942 ufoLastSysIncPath
= NULL
;
944 if (ufoLastIncPath
) free(ufoLastIncPath
);
945 ufoLastIncPath
= strdup(".");
951 if (ufoLastSysIncPath
) free(ufoLastSysIncPath
);
952 ufoLastSysIncPath
= strdup(fname
);
953 lslash
= ufoLastSysIncPath
;
954 cpos
= ufoLastSysIncPath
;
956 if (ufoLastIncPath
) free(ufoLastIncPath
);
957 ufoLastIncPath
= strdup(fname
);
958 lslash
= ufoLastIncPath
;
959 cpos
= ufoLastIncPath
;
963 if (*cpos
== '/' || *cpos
== '\\') lslash
= cpos
;
965 if (*cpos
== '/') lslash
= cpos
;
974 //==========================================================================
976 // ufoClearIncludePath
978 // required for UrAsm
980 //==========================================================================
981 void ufoClearIncludePath (void) {
982 if (ufoLastIncPath
!= NULL
) {
983 free(ufoLastIncPath
);
984 ufoLastIncPath
= NULL
;
986 if (ufoLastSysIncPath
!= NULL
) {
987 free(ufoLastSysIncPath
);
988 ufoLastSysIncPath
= NULL
;
993 //==========================================================================
997 //==========================================================================
998 static void ufoErrorPrintFile (FILE *fo
, const char *errwarn
) {
999 if (ufoInFileName
!= NULL
) {
1000 fprintf(fo
, "UFO %s at file %s, line %d: ", errwarn
, ufoInFileName
, ufoInFileLine
);
1002 fprintf(fo
, "UFO %s somewhere in time: ", errwarn
);
1007 //==========================================================================
1011 //==========================================================================
1012 static void ufoErrorMsgV (const char *errwarn
, const char *fmt
, va_list ap
) {
1014 if (!ufoLastEmitWasCR
) { printf("\n"); ufoLastEmitWasCR
= 1; }
1015 ufoErrorPrintFile(stderr
, errwarn
);
1016 vfprintf(stderr
, fmt
, ap
);
1018 fputc('\n', stderr
);
1023 //==========================================================================
1027 //==========================================================================
1028 __attribute__((format(printf
, 1, 2)))
1029 void ufoWarning (const char *fmt
, ...) {
1032 ufoErrorMsgV("WARNING", fmt
, ap
);
1036 //==========================================================================
1040 //==========================================================================
1041 __attribute__((noreturn
)) __attribute__((format(printf
, 1, 2)))
1042 void ufoFatal (const char *fmt
, ...) {
1048 ufoErrorMsgV("ERROR", fmt
, ap
);
1049 if (!ufoInBacktrace
) {
1051 ufoBacktrace(ufoIP
, 1);
1054 fprintf(stderr
, "DOUBLE FATAL: error in backtrace!\n");
1057 #ifdef UFO_DEBUG_FATAL_ABORT
1066 // ////////////////////////////////////////////////////////////////////////// //
1067 // working with the stacks
1068 #define UFO_TOS (ufoDStack[ufoSP - 1u])
1069 #define UFO_RTOS (ufoRStack[ufoRP - 1u])
1071 #define UFO_S(n_) (ufoDStack[ufoSP - 1u - (n_)])
1072 #define UFO_R(n_) (ufoRStack[ufoRP - 1u - (n_)])
1074 #define UFO_STACK(n_) if (ufoSP < (uint32_t)(n_)) ufoFatal("data stack underflow")
1075 #define UFO_RSTACK(n_) if (ufoRP < (uint32_t)(n_)) ufoFatal("return stack underflow")
1077 UFO_FORCE_INLINE
void ufoPush (uint32_t v
) { if (ufoSP
>= UFO_DSTACK_SIZE
) ufoFatal("data stack overflow"); ufoDStack
[ufoSP
++] = v
; }
1078 UFO_FORCE_INLINE
void ufoDrop (void) { if (ufoSP
== 0) ufoFatal("data stack underflow"); ufoSP
-= 1u; }
1079 UFO_FORCE_INLINE
uint32_t ufoPop (void) { if (ufoSP
== 0) { ufoFatal("data stack underflow"); } return ufoDStack
[--ufoSP
]; }
1080 UFO_FORCE_INLINE
uint32_t ufoPeek (void) { if (ufoSP
== 0) ufoFatal("data stack underflow"); return ufoDStack
[ufoSP
-1u]; }
1081 UFO_FORCE_INLINE
void ufoDup (void) { if (ufoSP
== 0) ufoFatal("data stack underflow"); ufoPush(ufoDStack
[ufoSP
-1u]); }
1082 UFO_FORCE_INLINE
void ufoOver (void) { if (ufoSP
< 2u) ufoFatal("data stack underflow"); ufoPush(ufoDStack
[ufoSP
-2u]); }
1083 UFO_FORCE_INLINE
void ufoSwap (void) { if (ufoSP
< 2u) ufoFatal("data stack underflow"); const uint32_t t
= ufoDStack
[ufoSP
-1u]; ufoDStack
[ufoSP
-1u] = ufoDStack
[ufoSP
-2u]; ufoDStack
[ufoSP
-2u] = t
; }
1084 UFO_FORCE_INLINE
void ufoRot (void) { if (ufoSP
< 3u) ufoFatal("data stack underflow"); const uint32_t t
= ufoDStack
[ufoSP
-3u]; ufoDStack
[ufoSP
-3u] = ufoDStack
[ufoSP
-2u]; ufoDStack
[ufoSP
-2u] = ufoDStack
[ufoSP
-1u]; ufoDStack
[ufoSP
-1u] = t
; }
1085 UFO_FORCE_INLINE
void ufoNRot (void) { if (ufoSP
< 3u) ufoFatal("data stack underflow"); const uint32_t t
= ufoDStack
[ufoSP
-1u]; ufoDStack
[ufoSP
-1u] = ufoDStack
[ufoSP
-2u]; ufoDStack
[ufoSP
-2u] = ufoDStack
[ufoSP
-3u]; ufoDStack
[ufoSP
-3u] = t
; }
1087 UFO_FORCE_INLINE
void ufo2Dup (void) { ufoOver(); ufoOver(); }
1088 UFO_FORCE_INLINE
void ufo2Drop (void) { UFO_STACK(2); ufoSP
-= 2u; }
1089 UFO_FORCE_INLINE
void ufo2Over (void) { if (ufoSP
< 4u) ufoFatal("data stack underflow"); const uint32_t n0
= ufoDStack
[ufoSP
-4u]; const uint32_t n1
= ufoDStack
[ufoSP
-3u]; ufoPush(n0
); ufoPush(n1
); }
1090 UFO_FORCE_INLINE
void ufo2Swap (void) { if (ufoSP
< 4u) ufoFatal("data stack underflow"); const uint32_t n0
= ufoDStack
[ufoSP
-4u]; const uint32_t n1
= ufoDStack
[ufoSP
-3u]; ufoDStack
[ufoSP
-4u] = ufoDStack
[ufoSP
-2u]; ufoDStack
[ufoSP
-3u] = ufoDStack
[ufoSP
-1u]; ufoDStack
[ufoSP
-2u] = n0
; ufoDStack
[ufoSP
-1u] = n1
; }
1092 UFO_FORCE_INLINE
void ufoRPush (uint32_t v
) { if (ufoRP
>= UFO_RSTACK_SIZE
) ufoFatal("return stack overflow"); ufoRStack
[ufoRP
++] = v
; }
1093 UFO_FORCE_INLINE
void ufoRDrop (void) { if (ufoRP
== 0) ufoFatal("return stack underflow"); --ufoRP
; }
1094 UFO_FORCE_INLINE
uint32_t ufoRPop (void) { if (ufoRP
== 0) ufoFatal("return stack underflow"); return ufoRStack
[--ufoRP
]; }
1095 UFO_FORCE_INLINE
uint32_t ufoRPeek (void) { if (ufoRP
== 0) ufoFatal("return stack underflow"); return ufoRStack
[ufoRP
-1u]; }
1096 UFO_FORCE_INLINE
void ufoRDup (void) { if (ufoRP
== 0) ufoFatal("return stack underflow"); ufoPush(ufoRStack
[ufoRP
-1u]); }
1098 UFO_FORCE_INLINE
void ufoPushBool (int v
) { ufoPush(v
? ufoTrueValue
: 0u); }
1101 #ifndef UFO_HUGE_IMAGES
1102 //==========================================================================
1106 //==========================================================================
1107 static void ufoImgEnsureSize (uint32_t addr
) {
1108 if ((addr
& UFO_ADDR_SPECIAL_BITS_MASK
) != 0) ufoFatal("ufoImgEnsureSize: internal error");
1109 if (addr
>= ufoImageSize
) {
1110 // 64MB should be enough for everyone!
1111 if (addr
>= 0x04000000U
) {
1112 ufoFatal("image grown too big (addr=0%08XH)", addr
);
1114 const uint32_t osz
= ufoImageSize
;
1115 // grow by 1MB steps
1116 const uint32_t nsz
= (addr
|0x000fffffU
) + 1U;
1117 ufo_assert(nsz
> addr
);
1118 uint32_t *nimg
= realloc(ufoImage
, nsz
);
1120 ufoFatal("out of memory for UFO image (%u -> %u MBs)",
1121 ufoImageSize
/ 1024u / 1024u,
1122 nsz
/ 1024u / 1024u);
1126 memset((char *)ufoImage
+ osz
, 0, (nsz
- osz
));
1131 //==========================================================================
1135 //==========================================================================
1136 static void ufoImgEnsureTemp (uint32_t addr
) {
1137 if ((addr
& UFO_ADDR_SPECIAL_BITS_MASK
) != 0) ufoFatal("ufoImgEnsureTemp: internal error");
1138 if (addr
>= ufoImageTempSize
) {
1139 if (addr
>= 1024u * 1024u) {
1140 ufoFatal("Forth segmentation fault at address 0x%08X", addr
| UFO_ADDR_TEMP_BIT
);
1142 const uint32_t osz
= ufoImageTempSize
;
1143 // grow by 64KB steps
1144 const uint32_t nsz
= (addr
|0x0000ffffU
) + 1U;
1145 uint32_t *nimg
= realloc(ufoImageTemp
, nsz
);
1147 ufoFatal("out of memory for temp UFO image (%u -> %u KBs)",
1148 ufoImageTempSize
/ 1024u,
1151 ufoImageTemp
= nimg
;
1152 ufoImageTempSize
= nsz
;
1153 memset((char *)ufoImageTemp
+ osz
, 0, (nsz
- osz
));
1159 #ifdef UFO_FAST_MEM_ACCESS
1160 //==========================================================================
1166 //==========================================================================
1167 UFO_FORCE_INLINE
void ufoImgPutU8 (uint32_t addr
, const uint32_t value
) {
1168 if ((addr
& UFO_ADDR_SPECIAL_BITS_MASK
) == 0) {
1169 if (addr
>= ufoImageSize
) {
1170 #ifdef UFO_HUGE_IMAGES
1171 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1173 ufoImgEnsureSize(addr
);
1176 *((uint8_t *)ufoImage
+ addr
) = (uint8_t)value
;
1177 } else if (addr
& UFO_ADDR_TEMP_BIT
) {
1178 addr
&= UFO_ADDR_TEMP_MASK
;
1179 if (addr
>= ufoImageTempSize
) {
1180 #ifdef UFO_HUGE_IMAGES
1181 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1183 ufoImgEnsureTemp(addr
);
1186 *((uint8_t *)ufoImageTemp
+ addr
) = (uint8_t)value
;
1187 } else if ((addr
& UFO_ADDR_HANDLE_BIT
) != 0) {
1188 ufoHandleStoreByte(addr
, 0, value
);
1190 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1195 //==========================================================================
1201 //==========================================================================
1202 UFO_FORCE_INLINE
void ufoImgPutU16 (uint32_t addr
, const uint32_t value
) {
1203 if ((addr
& UFO_ADDR_SPECIAL_BITS_MASK
) == 0) {
1204 if (addr
+ 1u >= ufoImageSize
) {
1205 #ifdef UFO_HUGE_IMAGES
1206 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1208 ufoImgEnsureSize(addr
+ 1u);
1211 *(uint16_t *)((uint8_t *)ufoImage
+ addr
) = (uint16_t)value
;
1212 } else if (addr
& UFO_ADDR_TEMP_BIT
) {
1213 addr
&= UFO_ADDR_TEMP_MASK
;
1214 if (addr
+ 1u >= ufoImageTempSize
) {
1215 #ifdef UFO_HUGE_IMAGES
1216 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1218 ufoImgEnsureTemp(addr
+ 1u);
1221 *(uint16_t *)((uint8_t *)ufoImageTemp
+ addr
) = (uint16_t)value
;
1222 } else if ((addr
& UFO_ADDR_HANDLE_BIT
) != 0) {
1223 ufoHandleStoreWord(addr
, 0, value
);
1225 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1230 //==========================================================================
1236 //==========================================================================
1237 UFO_FORCE_INLINE
void ufoImgPutU32 (uint32_t addr
, const uint32_t value
) {
1238 if ((addr
& UFO_ADDR_SPECIAL_BITS_MASK
) == 0) {
1239 if (addr
+ 3u >= ufoImageSize
) {
1240 #ifdef UFO_HUGE_IMAGES
1241 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1243 ufoImgEnsureSize(addr
+ 3u);
1246 *(uint32_t *)((uint8_t *)ufoImage
+ addr
) = value
;
1247 } else if (addr
& UFO_ADDR_TEMP_BIT
) {
1248 addr
&= UFO_ADDR_TEMP_MASK
;
1249 if (addr
+ 3u >= ufoImageTempSize
) {
1250 #ifdef UFO_HUGE_IMAGES
1251 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1253 ufoImgEnsureTemp(addr
+ 3u);
1256 *(uint32_t *)((uint8_t *)ufoImageTemp
+ addr
) = value
;
1257 } else if ((addr
& UFO_ADDR_HANDLE_BIT
) != 0) {
1258 ufoHandleStoreCell(addr
, 0, value
);
1260 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1265 //==========================================================================
1271 //==========================================================================
1272 UFO_FORCE_INLINE
uint32_t *ufoImgIOPtrU32 (uint32_t addr
) {
1273 if ((addr
& UFO_ADDR_SPECIAL_BITS_MASK
) == 0) {
1274 if (addr
+ 3u >= ufoImageSize
) {
1275 #ifdef UFO_HUGE_IMAGES
1276 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1278 ufoImgEnsureSize(addr
+ 3u);
1281 return (uint32_t *)((uint8_t *)ufoImage
+ addr
);
1282 } else if (addr
& UFO_ADDR_TEMP_BIT
) {
1283 addr
&= UFO_ADDR_TEMP_MASK
;
1284 if (addr
+ 3u >= ufoImageTempSize
) {
1285 #ifdef UFO_HUGE_IMAGES
1286 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1288 ufoImgEnsureTemp(addr
+ 3u);
1291 return (uint32_t *)((uint8_t *)ufoImageTemp
+ addr
);
1293 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1298 //==========================================================================
1304 //==========================================================================
1305 UFO_FORCE_INLINE
uint32_t ufoImgGetU8 (uint32_t addr
) {
1306 if ((addr
& UFO_ADDR_SPECIAL_BITS_MASK
) == 0) {
1307 if (addr
>= ufoImageSize
) {
1308 // accessing unallocated image area is segmentation fault
1309 ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr
);
1311 return *((const uint8_t *)ufoImage
+ addr
);
1312 } else if (addr
& UFO_ADDR_TEMP_BIT
) {
1313 addr
&= UFO_ADDR_TEMP_MASK
;
1314 if (addr
>= ufoImageTempSize
) {
1315 // accessing unallocated image area is segmentation fault
1316 ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr
| UFO_ADDR_TEMP_BIT
);
1318 return *((const uint8_t *)ufoImageTemp
+ addr
);
1319 } else if ((addr
& UFO_ADDR_HANDLE_BIT
) != 0) {
1320 return ufoHandleLoadByte(addr
, 0);
1322 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1327 //==========================================================================
1333 //==========================================================================
1334 UFO_FORCE_INLINE
uint32_t ufoImgGetU16 (uint32_t addr
) {
1335 if ((addr
& UFO_ADDR_SPECIAL_BITS_MASK
) == 0) {
1336 if (addr
+ 1u >= ufoImageSize
) {
1337 // accessing unallocated image area is segmentation fault
1338 ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr
);
1340 return *(const uint16_t *)((const uint8_t *)ufoImage
+ addr
);
1341 } else if (addr
& UFO_ADDR_TEMP_BIT
) {
1342 addr
&= UFO_ADDR_TEMP_MASK
;
1343 if (addr
+ 1u >= ufoImageTempSize
) {
1344 // accessing unallocated image area is segmentation fault
1345 ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr
| UFO_ADDR_TEMP_BIT
);
1347 return *(const uint16_t *)((const uint8_t *)ufoImageTemp
+ addr
);
1348 } else if ((addr
& UFO_ADDR_HANDLE_BIT
) != 0) {
1349 return ufoHandleLoadWord(addr
, 0);
1351 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1356 //==========================================================================
1362 //==========================================================================
1363 UFO_FORCE_INLINE
uint32_t ufoImgGetU32 (uint32_t addr
) {
1364 if ((addr
& UFO_ADDR_SPECIAL_BITS_MASK
) == 0) {
1365 if (addr
+ 3u >= ufoImageSize
) {
1366 // accessing unallocated image area is segmentation fault
1367 ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr
);
1369 return *(const uint32_t *)((const uint8_t *)ufoImage
+ addr
);
1370 } else if (addr
& UFO_ADDR_TEMP_BIT
) {
1371 addr
&= UFO_ADDR_TEMP_MASK
;
1372 if (addr
+ 3u >= ufoImageTempSize
) {
1373 // accessing unallocated image area is segmentation fault
1374 ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr
| UFO_ADDR_TEMP_BIT
);
1376 return *(const uint32_t *)((const uint8_t *)ufoImageTemp
+ addr
);
1377 } else if ((addr
& UFO_ADDR_HANDLE_BIT
) != 0) {
1378 return ufoHandleLoadCell(addr
, 0);
1380 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1386 //==========================================================================
1392 //==========================================================================
1393 UFO_FORCE_INLINE
void ufoImgPutU8 (uint32_t addr
, const uint32_t value
) {
1395 if ((addr
& UFO_ADDR_SPECIAL_BITS_MASK
) == 0) {
1396 if (addr
>= ufoImageSize
) {
1397 #ifdef UFO_HUGE_IMAGES
1398 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1400 ufoImgEnsureSize(addr
);
1403 imgptr
= &ufoImage
[addr
/4u];
1404 } else if (addr
& UFO_ADDR_TEMP_BIT
) {
1405 addr
&= UFO_ADDR_TEMP_MASK
;
1406 if (addr
>= ufoImageTempSize
) {
1407 #ifdef UFO_HUGE_IMAGES
1408 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1410 ufoImgEnsureTemp(addr
);
1413 imgptr
= &ufoImageTemp
[addr
/4u];
1414 } else if ((addr
& UFO_ADDR_HANDLE_BIT
) != 0) {
1415 ufoHandleStoreByte(addr
, 0, value
);
1417 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1419 const uint8_t val
= (uint8_t)value
;
1420 memcpy((uint8_t *)imgptr
+ (addr
&3), &val
, 1);
1424 //==========================================================================
1430 //==========================================================================
1431 UFO_FORCE_INLINE
void ufoImgPutU16 (uint32_t addr
, const uint32_t value
) {
1432 ufoImgPutU8(addr
, value
&0xffU
);
1433 ufoImgPutU8(addr
+ 1u, (value
>>8)&0xffU
);
1437 //==========================================================================
1443 //==========================================================================
1444 UFO_FORCE_INLINE
void ufoImgPutU32 (uint32_t addr
, const uint32_t value
) {
1445 ufoImgPutU16(addr
, value
&0xffffU
);
1446 ufoImgPutU16(addr
+ 2u, (value
>>16)&0xffffU
);
1450 //==========================================================================
1456 //==========================================================================
1457 UFO_FORCE_INLINE
uint32_t ufoImgGetU8 (uint32_t addr
) {
1459 if ((addr
& UFO_ADDR_SPECIAL_BITS_MASK
) == 0) {
1460 if (addr
>= ufoImageSize
) {
1461 // accessing unallocated image area is segmentation fault
1462 ufoFatal("Forth segmentation fault (unallocated access) at address 0x%08X", addr
);
1464 imgptr
= &ufoImage
[addr
/4u];
1465 } else if (addr
& UFO_ADDR_TEMP_BIT
) {
1466 addr
&= UFO_ADDR_TEMP_MASK
;
1467 if (addr
>= ufoImageTempSize
) return 0;
1468 imgptr
= &ufoImageTemp
[addr
/4u];
1469 } else if ((addr
& UFO_ADDR_HANDLE_BIT
) != 0) {
1470 return ufoHandleLoadByte(addr
, 0, value
);
1472 ufoFatal("Forth segmentation fault at address 0x%08X", addr
);
1475 memcpy(&val
, (uint8_t *)imgptr
+ (addr
&3), 1);
1476 return (uint32_t)val
;
1480 //==========================================================================
1486 //==========================================================================
1487 UFO_FORCE_INLINE
uint32_t ufoImgGetU16 (uint32_t addr
) {
1488 return ufoImgGetU8(addr
) | (ufoImgGetU8(addr
+ 1u) << 8);
1492 //==========================================================================
1498 //==========================================================================
1499 UFO_FORCE_INLINE
uint32_t ufoImgGetU32 (uint32_t addr
) {
1500 return ufoImgGetU16(addr
) | (ufoImgGetU16(addr
+ 2u) << 16);
1505 //==========================================================================
1507 // ufoEnsureDebugSize
1509 //==========================================================================
1510 UFO_DISABLE_INLINE
void ufoEnsureDebugSize (uint32_t sdelta
) {
1511 ufo_assert(sdelta
!= 0);
1512 if (ufoDebugImageSize
!= 0) {
1513 if (ufoDebugImageUsed
+ sdelta
>= 0x40000000U
) ufoFatal("debug info too big");
1514 if (ufoDebugImageUsed
+ sdelta
> ufoDebugImageSize
) {
1515 // grow by 32KB, this should be more than enough
1516 const uint32_t newsz
= ((ufoDebugImageUsed
+ sdelta
) | 0x7fffU
) + 1u;
1517 uint8_t *ndb
= realloc(ufoDebugImage
, newsz
);
1518 if (ndb
== NULL
) ufoFatal("out of memory for debug info");
1519 ufoDebugImage
= ndb
;
1520 ufoDebugImageSize
= newsz
;
1523 // initial allocation: 32KB, quite a lot
1524 ufo_assert(ufoDebugImage
== NULL
);
1525 ufo_assert(ufoDebugImageUsed
== 0);
1526 ufoDebugImageSize
= 1024 * 32;
1527 ufoDebugImage
= malloc(ufoDebugImageSize
);
1528 if (ufoDebugImage
== NULL
) ufoFatal("out of memory for debug info");
1533 #define UFO_DBG_PUT_U4(val_) do { \
1534 const uint32_t vv_ = (val_); \
1535 *((uint32_t *)(ufoDebugImage + ufoDebugImageUsed)) = vv_; \
1536 ufoDebugImageUsed += 4u; \
1543 ...first line info header...
1544 line info header (or reset):
1545 db 0 ; zero line delta
1546 dw followFileInfoSize ; either it, or 0 if reused
1547 dd fileInfoOfs ; present only if reused
1555 dd nameLen ; without terminating 0
1556 ...name... (0-terminated)
1558 we will never compare file names: length and hash should provide
1559 good enough unique identifier.
1561 static uint8_t *ufoDebugImage = NULL;
1562 static uint32_t ufoDebugImageUsed = 0; // in bytes
1563 static uint32_t ufoDebugImageSize = 0; // in bytes
1564 static uint32_t ufoDebugFileNameHash = 0; // current file name hash
1565 static uint32_t ufoDebugFileNameLen = 0; // current file name length
1566 static uint32_t ufoDebugCurrDP = 0;
1570 //==========================================================================
1572 // ufoSkipDebugVarInt
1574 //==========================================================================
1575 static __attribute__((unused
)) uint32_t ufoSkipDebugVarInt (uint32_t ofs
) {
1578 if (ofs
>= ufoDebugImageUsed
) ufoFatal("invalid debug data");
1579 byte
= ufoDebugImage
[ofs
]; ofs
+= 1u;
1580 } while (byte
>= 0x80);
1585 //==========================================================================
1587 // ufoCalcDebugVarIntSize
1589 //==========================================================================
1590 UFO_FORCE_INLINE
uint8_t ufoCalcDebugVarIntSize (uint32_t v
) {
1600 //==========================================================================
1602 // ufoGetDebugVarInt
1604 //==========================================================================
1605 static __attribute__((unused
)) uint32_t ufoGetDebugVarInt (uint32_t ofs
) {
1610 if (ofs
>= ufoDebugImageUsed
) ufoFatal("invalid debug data");
1611 byte
= ufoDebugImage
[ofs
];
1612 v
|= (uint32_t)(byte
& 0x7f) << shift
;
1617 } while (byte
>= 0x80);
1622 //==========================================================================
1624 // ufoPutDebugVarInt
1626 //==========================================================================
1627 UFO_FORCE_INLINE
void ufoPutDebugVarInt (uint32_t v
) {
1628 ufoEnsureDebugSize(5u); // maximum size
1631 ufoDebugImage
[ufoDebugImageUsed
] = (uint8_t)(v
| 0x80u
);
1633 ufoDebugImage
[ufoDebugImageUsed
] = (uint8_t)v
;
1635 ufoDebugImageUsed
+= 1;
1641 #ifdef UFO_DEBUG_DEBUG
1642 //==========================================================================
1646 //==========================================================================
1647 static void ufoDumpDebugImage (void) {
1649 uint32_t dbgpos
= 4u; // first line header info
1650 uint32_t lastline
= 0;
1651 uint32_t lastdp
= 0;
1652 while (dbgpos
< ufoDebugImageUsed
) {
1653 if (ufoDebugImage
[dbgpos
] == 0) {
1655 dbgpos
+= 1u; // skip flag
1656 const uint32_t fhdrSize
= *(const uint16_t *)(ufoDebugImage
+ dbgpos
); dbgpos
+= 2u;
1657 lastdp
= ufoGetDebugVarInt(dbgpos
);
1658 dbgpos
= ufoSkipDebugVarInt(dbgpos
);
1659 if (fhdrSize
== 0) {
1661 const uint32_t infoOfs
= *(const uint32_t *)(ufoDebugImage
+ dbgpos
); dbgpos
+= 4u;
1662 fprintf(stderr
, "*** OLD FILE: %s\n", (const char *)(ufoDebugImage
+ infoOfs
+ 3u * 4u));
1663 fprintf(stderr
, "FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage
+ infoOfs
))[2]);
1664 fprintf(stderr
, "FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage
+ infoOfs
))[1]);
1667 fprintf(stderr
, "*** NEW FILE: %s\n", (const char *)(ufoDebugImage
+ dbgpos
+ 3u * 4u));
1668 fprintf(stderr
, "FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage
+ dbgpos
))[2]);
1669 fprintf(stderr
, "FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage
+ dbgpos
))[1]);
1672 fprintf(stderr
, "LINES-OFS: 0x%08x (hsz: %u -- 0x%08x)\n", dbgpos
, fhdrSize
, fhdrSize
);
1673 lastline
= ~(uint32_t)0;
1675 const uint32_t ln
= ufoGetDebugVarInt(dbgpos
);
1676 dbgpos
= ufoSkipDebugVarInt(dbgpos
);
1677 ufo_assert(ln
!= 0);
1679 const uint32_t edp
= ufoGetDebugVarInt(dbgpos
);
1680 dbgpos
= ufoSkipDebugVarInt(dbgpos
);
1682 fprintf(stderr
, " line %6u: edp=%u\n", lastline
, lastdp
);
1690 //==========================================================================
1692 // ufoRecordDebugCheckFile
1694 // if we moved to the new file:
1695 // put "line info header"
1696 // put new file info (or reuse old)
1698 //==========================================================================
1699 UFO_FORCE_INLINE
void ufoRecordDebugCheckFile (void) {
1700 if (ufoDebugImageUsed
== 0 ||
1701 ufoDebugFileNameLen
!= ufoInFileNameLen
||
1702 ufoDebugFileNameHash
!= ufoInFileNameHash
)
1704 // new file record (or reuse old one)
1705 const int initial
= (ufoDebugImageUsed
== 0);
1706 uint32_t fileRec
= 0;
1707 // try to find and old one
1709 fileRec
= *(const uint32_t *)ufoDebugImage
;
1711 fprintf(stderr
, "*** NEW-FILE(%u): 0x%08x: <%s> (frec=0x%08x)\n", ufoInFileNameLen
,
1712 ufoInFileNameHash
, ufoInFileName
, fileRec
);
1714 while (fileRec
!= 0 &&
1715 (ufoInFileNameLen
!= ((const uint32_t *)(ufoDebugImage
+ fileRec
))[1] ||
1716 ufoInFileNameHash
!= ((const uint32_t *)(ufoDebugImage
+ fileRec
))[2]))
1719 fprintf(stderr
, "*** FRCHECK: 0x%08x\n", fileRec
);
1720 fprintf(stderr
, " FILE NAME: %s\n", (const char *)(ufoDebugImage
+ fileRec
+ 3u * 4u));
1721 fprintf(stderr
, " FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage
+ fileRec
))[2]);
1722 fprintf(stderr
, " FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage
+ fileRec
))[1]);
1723 fprintf(stderr
, " FILE PREV: 0x%08x\n", *(const uint32_t *)(ufoDebugImage
+ fileRec
));
1725 fileRec
= *(const uint32_t *)(ufoDebugImage
+ fileRec
);
1728 fprintf(stderr
, "*** FRCHECK-DONE: 0x%08x\n", fileRec
);
1730 fprintf(stderr
, " FILE NAME: %s\n", (const char *)(ufoDebugImage
+ fileRec
+ 3u * 4u));
1731 fprintf(stderr
, " FILE NAME LEN: %u\n", ((const uint32_t *)(ufoDebugImage
+ fileRec
))[2]);
1732 fprintf(stderr
, " FILE NAME HASH: 0x%08x\n", ((const uint32_t *)(ufoDebugImage
+ fileRec
))[1]);
1733 fprintf(stderr
, " FILE PREV: 0x%08x\n", *(const uint32_t *)(ufoDebugImage
+ fileRec
));
1737 ufoEnsureDebugSize(8u);
1738 *(uint32_t *)ufoDebugImage
= 0;
1740 // write "line info header"
1742 ufoEnsureDebugSize(32u);
1743 ufoDebugImage
[ufoDebugImageUsed
] = 0; ufoDebugImageUsed
+= 1u; // header flag (0 delta)
1744 // file record size: 0 (reused)
1745 *((uint16_t *)(ufoDebugImage
+ ufoDebugImageUsed
)) = 0; ufoDebugImageUsed
+= 2u;
1747 ufoPutDebugVarInt(ufoDebugCurrDP
);
1749 UFO_DBG_PUT_U4(fileRec
);
1751 // name, trailing 0 byte, 3 dword fields
1752 const uint32_t finfoSize
= ufoInFileNameLen
+ 1u + 3u * 4u;
1753 ufo_assert(finfoSize
< 65536u);
1754 ufoEnsureDebugSize(finfoSize
+ 32u);
1756 *(uint32_t *)ufoDebugImage
= 0;
1757 ufoDebugImageUsed
= 4;
1759 ufoDebugImage
[ufoDebugImageUsed
] = 0; ufoDebugImageUsed
+= 1u; // header flag (0 delta)
1761 *((uint16_t *)(ufoDebugImage
+ ufoDebugImageUsed
)) = (uint16_t)finfoSize
; ufoDebugImageUsed
+= 2u;
1763 ufoPutDebugVarInt(ufoDebugCurrDP
);
1764 // file record follows
1765 // fix file info offsets
1766 uint32_t lastOfs
= *(const uint32_t *)ufoDebugImage
;
1767 *(uint32_t *)ufoDebugImage
= ufoDebugImageUsed
;
1768 UFO_DBG_PUT_U4(lastOfs
);
1769 // save file info hash
1770 UFO_DBG_PUT_U4(ufoInFileNameHash
);
1771 // save file info length
1772 UFO_DBG_PUT_U4(ufoInFileNameLen
);
1774 if (ufoInFileNameLen
!= 0) {
1775 memcpy(ufoDebugImage
+ ufoDebugImageUsed
, ufoInFileName
, ufoInFileNameLen
+ 1u);
1776 ufoDebugImageUsed
+= ufoInFileNameLen
+ 1u;
1778 ufoDebugImage
[ufoDebugImageUsed
] = 0; ufoDebugImageUsed
+= 1u;
1781 ufoDebugFileNameLen
= ufoInFileNameLen
;
1782 ufoDebugFileNameHash
= ufoInFileNameHash
;
1783 ufoDebugLastLine
= ~(uint32_t)0;
1784 ufoDebugLastLinePCOfs
= 0;
1785 ufoDebugLastLineDP
= ufoDebugCurrDP
;
1790 //==========================================================================
1792 // ufoRecordDebugRecordLine
1794 //==========================================================================
1795 UFO_FORCE_INLINE
void ufoRecordDebugRecordLine (uint32_t line
, uint32_t newhere
) {
1796 if (line
== ufoDebugLastLine
) {
1797 ufo_assert(ufoDebugLastLinePCOfs
!= 0);
1798 ufoDebugImageUsed
= ufoDebugLastLinePCOfs
;
1801 fprintf(stderr
, "FL-NEW-LINE(0x%08x): <%s>; new line: %u (old: %u)\n",
1803 ufoInFileName
, line
, ufoDebugLastLine
);
1805 ufoPutDebugVarInt(line
- ufoDebugLastLine
);
1806 ufoDebugLastLinePCOfs
= ufoDebugImageUsed
;
1807 ufoDebugLastLine
= line
;
1808 ufoDebugLastLineDP
= ufoDebugCurrDP
;
1810 ufoPutDebugVarInt(newhere
- ufoDebugLastLineDP
);
1811 ufoDebugCurrDP
= newhere
;
1815 //==========================================================================
1819 //==========================================================================
1820 UFO_DISABLE_INLINE
void ufoRecordDebug (uint32_t newhere
) {
1821 if (newhere
> ufoDebugCurrDP
) {
1822 uint32_t ln
= (uint32_t)ufoInFileLine
;
1823 if (ln
== ~(uint32_t)0) ln
= 0;
1825 fprintf(stderr
, "FL: <%s>; line: %d\n", ufoInFileName
, ufoInFileLine
);
1827 ufoRecordDebugCheckFile();
1828 ufoRecordDebugRecordLine(ln
, newhere
);
1833 //==========================================================================
1835 // ufoGetWordEndAddrYFA
1837 //==========================================================================
1838 static uint32_t ufoGetWordEndAddrYFA (uint32_t yfa
) {
1840 const uint32_t oyfa
= yfa
;
1841 yfa
= ufoImgGetU32(yfa
); // YFA points to next YFA
1843 // last defined word
1844 if ((oyfa
& UFO_ADDR_TEMP_BIT
) == 0) {
1845 yfa
= ufoImgGetU32(ufoAddrDP
);
1847 yfa
= ufoImgGetU32(ufoAddrDPTemp
);
1850 yfa
= UFO_YFA_TO_WST(yfa
);
1859 //==========================================================================
1861 // ufoGetWordEndAddr
1863 //==========================================================================
1864 static uint32_t ufoGetWordEndAddr (const uint32_t cfa
) {
1866 const uint32_t lfa
= UFO_CFA_TO_LFA(cfa
);
1867 const uint32_t yfa
= UFO_LFA_TO_YFA(lfa
);
1868 return ufoGetWordEndAddrYFA(yfa
);
1875 //==========================================================================
1881 // WARNING: this is SLOW!
1883 //==========================================================================
1884 static uint32_t ufoFindWordForIP (const uint32_t ip
) {
1887 //fprintf(stderr, "ufoFindWordForIP:000: ip=0x%08x\n", ip);
1888 // iterate over all words
1889 uint32_t xfa
= ufoImgGetU32(ufoAddrLastXFA
);
1890 //fprintf(stderr, "ufoFindWordForIP:001: xfa=0x%08x\n", xfa);
1892 while (res
== 0 && xfa
!= 0) {
1893 const uint32_t yfa
= UFO_XFA_TO_YFA(xfa
);
1894 const uint32_t wst
= UFO_YFA_TO_WST(yfa
);
1895 //fprintf(stderr, "ufoFindWordForIP:002: yfa=0x%08x; wst=0x%08x\n", yfa, wst);
1896 const uint32_t wend
= ufoGetWordEndAddrYFA(yfa
);
1897 if (ip
>= wst
&& ip
< wend
) {
1898 res
= UFO_YFA_TO_NFA(yfa
);
1900 xfa
= ufoImgGetU32(xfa
);
1909 //==========================================================================
1913 // return file name or `NULL`
1915 // WARNING: this is SLOW!
1917 //==========================================================================
1918 static const char *ufoFindFileForIP (uint32_t ip
, uint32_t *line
,
1919 uint32_t *nlen
, uint32_t *nhash
)
1921 if (ip
!= 0 && ufoDebugImageUsed
!= 0) {
1922 const char *filename
= NULL
;
1923 uint32_t dbgpos
= 4u; // first line header info
1924 uint32_t lastline
= 0;
1925 uint32_t lastdp
= 0;
1926 uint32_t namelen
= 0;
1927 uint32_t namehash
= 0;
1928 while (dbgpos
< ufoDebugImageUsed
) {
1929 if (ufoDebugImage
[dbgpos
] == 0) {
1931 dbgpos
+= 1u; // skip flag
1932 const uint32_t fhdrSize
= *(const uint16_t *)(ufoDebugImage
+ dbgpos
); dbgpos
+= 2u;
1933 lastdp
= ufoGetDebugVarInt(dbgpos
);
1934 dbgpos
= ufoSkipDebugVarInt(dbgpos
);
1936 if (fhdrSize
== 0) {
1938 infoOfs
= *(const uint32_t *)(ufoDebugImage
+ dbgpos
); dbgpos
+= 4u;
1943 filename
= (const char *)(ufoDebugImage
+ infoOfs
+ 3u * 4u);
1944 namelen
= ((const uint32_t *)(ufoDebugImage
+ infoOfs
))[2];
1945 namehash
= ((const uint32_t *)(ufoDebugImage
+ infoOfs
))[1];
1946 if (filename
[0] == 0) filename
= NULL
;
1948 lastline
= ~(uint32_t)0;
1950 const uint32_t ln
= ufoGetDebugVarInt(dbgpos
);
1951 dbgpos
= ufoSkipDebugVarInt(dbgpos
);
1952 ufo_assert(ln
!= 0);
1954 const uint32_t edp
= ufoGetDebugVarInt(dbgpos
);
1955 dbgpos
= ufoSkipDebugVarInt(dbgpos
);
1956 if (ip
>= lastdp
&& ip
< lastdp
+ edp
) {
1957 if (line
) *line
= lastline
;
1958 if (nlen
) *nlen
= namelen
;
1959 if (nhash
) *nhash
= namehash
;
1966 if (line
) *line
= 0;
1967 if (nlen
) *nlen
= 0;
1968 if (nhash
) *nlen
= 0;
1973 //==========================================================================
1977 //==========================================================================
1978 UFO_FORCE_INLINE
void ufoBumpDP (uint32_t delta
) {
1979 const uint32_t dpa
= ufoImgGetU32(ufoAddrHereDP
);
1980 uint32_t dp
= ufoImgGetU32(dpa
);
1981 if ((dp
& UFO_ADDR_SPECIAL_BITS_MASK
) == 0) ufoRecordDebug(dp
+ delta
);
1983 ufoImgPutU32(dpa
, dp
);
1987 //==========================================================================
1991 //==========================================================================
1992 UFO_FORCE_INLINE
void ufoImgEmitU8 (uint32_t value
) {
1993 ufoImgPutU8(UFO_GET_DP(), value
);
1998 //==========================================================================
2002 //==========================================================================
2003 UFO_FORCE_INLINE
void ufoImgEmitU16 (uint32_t value
) {
2004 ufoImgPutU16(UFO_GET_DP(), value
);
2009 //==========================================================================
2013 //==========================================================================
2014 UFO_FORCE_INLINE
void ufoImgEmitU32 (uint32_t value
) {
2015 ufoImgPutU32(UFO_GET_DP(), value
);
2020 //==========================================================================
2024 //==========================================================================
2025 UFO_FORCE_INLINE
void ufoImgEmitCFA (uint32_t cfa
) {
2026 const uint32_t addr
= UFO_GET_DP();
2027 ufoImgPutU32(addr
, cfa
);
2028 ufoImgPutU32(addr
+ 4u, 0);
2033 #ifdef UFO_FAST_MEM_ACCESS
2035 //==========================================================================
2037 // ufoImgEmitU32_NoInline
2041 //==========================================================================
2042 UFO_FORCE_INLINE
void ufoImgEmitU32_NoInline (uint32_t value
) {
2043 ufoImgPutU32(UFO_GET_DP(), value
);
2049 //==========================================================================
2051 // ufoImgEmitU32_NoInline
2055 //==========================================================================
2056 UFO_DISABLE_INLINE
void ufoImgEmitU32_NoInline (uint32_t value
) {
2057 ufoImgPutU32(UFO_GET_DP(), value
);
2064 //==========================================================================
2068 //==========================================================================
2069 UFO_FORCE_INLINE
void ufoImgEmitAlign (void) {
2070 while ((UFO_GET_DP() & 3) != 0) ufoImgEmitU8(0);
2074 //==========================================================================
2078 //==========================================================================
2079 UFO_FORCE_INLINE
void ufoResetTib (void) {
2080 uint32_t defTIB
= ufoImgGetU32(ufoAddrDefTIB
);
2081 //fprintf(stderr, "ufoResetTib(%p): defTIB=0x%08x\n", ufoCurrState, defTIB);
2083 // create new TIB handle
2084 UfoHandle
*tibh
= ufoAllocHandle(0x69a029a6); // arbitrary number
2085 defTIB
= tibh
->ufoHandle
;
2086 ufoImgPutU32(ufoAddrDefTIB
, defTIB
);
2088 if ((defTIB
& UFO_ADDR_HANDLE_BIT
) != 0) {
2089 UfoHandle
*hh
= ufoGetHandle(defTIB
);
2090 if (hh
== NULL
) ufoFatal("default TIB is not allocated");
2091 if (hh
->size
== 0) {
2092 ufo_assert(hh
->data
== NULL
);
2093 hh
->data
= calloc(1, UFO_ADDR_HANDLE_OFS_MASK
+ 1);
2094 if (hh
->data
== NULL
) ufoFatal("out of memory for default TIB");
2095 hh
->size
= UFO_ADDR_HANDLE_OFS_MASK
+ 1;
2098 const uint32_t oldA
= ufoRegA
;
2099 ufoImgPutU32(ufoAddrTIBx
, defTIB
);
2100 ufoImgPutU32(ufoAddrINx
, 0);
2102 ufoPush(0); // value
2103 ufoPush(0); // offset
2104 UFCALL(CPOKE_REGA_IDX
);
2109 //==========================================================================
2113 //==========================================================================
2114 UFO_DISABLE_INLINE
void ufoTibEnsureSize (uint32_t size
) {
2115 if (size
> 1024u * 1024u * 256u) ufoFatal("TIB size too big");
2116 const uint32_t tib
= ufoImgGetU32(ufoAddrTIBx
);
2117 //fprintf(stderr, "ufoTibEnsureSize: TIB=0x%08x; size=%u\n", tib, size);
2118 if ((tib
& UFO_ADDR_HANDLE_BIT
) != 0) {
2119 UfoHandle
*hh
= ufoGetHandle(tib
);
2121 ufoFatal("cannot resize TIB, TIB is not a handle");
2123 if (hh
->size
< size
) {
2124 const uint32_t newsz
= (size
| 0xfffU
) + 1u;
2125 uint8_t *nx
= realloc(hh
->data
, newsz
);
2126 if (nx
== NULL
) ufoFatal("out of memory for restored TIB");
2133 ufoFatal("cannot resize TIB, TIB is not a handle (0x%08x)", tib
);
2139 //==========================================================================
2143 //==========================================================================
2145 UFO_DISABLE_INLINE uint32_t ufoTibGetSize (void) {
2146 const uint32_t tib = ufoImgGetU32(ufoAddrTIBx);
2147 if ((tib & UFO_ADDR_HANDLE_BIT) == 0) {
2148 ufoFatal("cannot query TIB, TIB is not a handle");
2150 UfoHandle *hh = ufoGetHandle(tib);
2152 ufoFatal("cannot query TIB, TIB is not a handle");
2159 //==========================================================================
2163 //==========================================================================
2164 UFO_FORCE_INLINE
uint8_t ufoTibPeekCh (void) {
2165 return (uint8_t)ufoImgGetU8(ufoImgGetU32(ufoAddrTIBx
) + ufoImgGetU32(ufoAddrINx
));
2169 //==========================================================================
2173 //==========================================================================
2174 UFO_FORCE_INLINE
uint8_t ufoTibPeekChOfs (uint32_t ofs
) {
2175 const uint32_t tib
= ufoImgGetU32(ufoAddrTIBx
);
2176 if (ofs
<= UFO_ADDR_HANDLE_OFS_MASK
|| (tib
& UFO_ADDR_HANDLE_BIT
) == 0) {
2177 return (uint8_t)ufoImgGetU8(tib
+ ufoImgGetU32(ufoAddrINx
) + ofs
);
2184 //==========================================================================
2188 //==========================================================================
2189 UFO_DISABLE_INLINE
void ufoTibPokeChOfs (uint8_t ch
, uint32_t ofs
) {
2190 const uint32_t oldA
= ufoRegA
;
2191 ufoRegA
= ufoImgGetU32(ufoAddrTIBx
);
2193 ufoPush(ufoImgGetU32(ufoAddrINx
) + ofs
);
2194 UFCALL(CPOKE_REGA_IDX
);
2199 //==========================================================================
2203 //==========================================================================
2204 UFO_FORCE_INLINE
uint8_t ufoTibGetCh (void) {
2205 const uint8_t ch
= ufoTibPeekCh();
2206 if (ch
) ufoImgPutU32(ufoAddrINx
, ufoImgGetU32(ufoAddrINx
) + 1u);
2211 //==========================================================================
2215 //==========================================================================
2216 UFO_FORCE_INLINE
void ufoTibSkipCh (void) {
2217 (void)ufoTibGetCh();
2221 // ////////////////////////////////////////////////////////////////////////// //
2222 // native CFA implementations
2225 //==========================================================================
2229 //==========================================================================
2230 static void ufoDoForth (uint32_t pfa
) {
2236 //==========================================================================
2240 //==========================================================================
2241 static void ufoDoVariable (uint32_t pfa
) {
2246 //==========================================================================
2248 // ufoDoUserVariable
2250 //==========================================================================
2251 static void ufoDoUserVariable (uint32_t pfa
) {
2252 ufoPush(ufoImgGetU32(pfa
));
2256 //==========================================================================
2260 //==========================================================================
2261 static void ufoDoValue (uint32_t pfa
) {
2262 ufoPush(ufoImgGetU32(pfa
));
2266 //==========================================================================
2270 //==========================================================================
2271 static void ufoDoConst (uint32_t pfa
) {
2272 ufoPush(ufoImgGetU32(pfa
));
2276 //==========================================================================
2280 //==========================================================================
2281 static void ufoDoDefer (uint32_t pfa
) {
2282 pfa
= ufoImgGetU32(pfa
);
2287 //==========================================================================
2291 //==========================================================================
2292 static void ufoDoDoes (uint32_t pfa
) {
2295 ufoIP
= ufoImgGetU32(UFO_PFA_TO_DOES_CFA(pfa
));
2299 //==========================================================================
2303 //==========================================================================
2304 static void ufoDoRedirect (uint32_t pfa
) {
2305 pfa
= ufoImgGetU32(UFO_PFA_TO_DOES_CFA(pfa
));
2310 //==========================================================================
2314 //==========================================================================
2315 static void ufoDoVoc (uint32_t pfa
) {
2316 ufoImgPutU32(ufoAddrContext
, ufoImgGetU32(pfa
));
2320 //==========================================================================
2324 //==========================================================================
2325 static void ufoDoCreate (uint32_t pfa
) {
2330 //==========================================================================
2334 // this also increments last used file id
2336 //==========================================================================
2337 static void ufoPushInFile (void) {
2338 if (ufoFileStackPos
>= UFO_MAX_NESTED_INCLUDES
) ufoFatal("too many includes");
2339 UFOFileStackEntry
*stk
= &ufoFileStack
[ufoFileStackPos
];
2340 stk
->fl
= ufoInFile
;
2341 stk
->fname
= ufoInFileName
;
2342 stk
->fline
= ufoInFileLine
;
2343 stk
->id
= ufoFileId
;
2344 stk
->incpath
= (ufoLastIncPath
? strdup(ufoLastIncPath
) : NULL
);
2345 stk
->sysincpath
= (ufoLastSysIncPath
? strdup(ufoLastSysIncPath
) : NULL
);
2346 ufoFileStackPos
+= 1;
2348 ufoInFileName
= NULL
; ufoInFileNameLen
= 0; ufoInFileNameHash
= 0;
2350 ufoLastUsedFileId
+= 1;
2351 ufo_assert(ufoLastUsedFileId
!= 0); // just in case ;-)
2352 //ufoLastIncPath = NULL;
2356 //==========================================================================
2358 // ufoWipeIncludeStack
2360 //==========================================================================
2361 static void ufoWipeIncludeStack (void) {
2362 if (ufoInFileName
) { free(ufoInFileName
); ufoInFileName
= NULL
; }
2363 if (ufoInFile
) { fclose(ufoInFile
); ufoInFile
= NULL
; }
2364 if (ufoLastIncPath
) { free(ufoLastIncPath
); ufoLastIncPath
= NULL
; }
2365 if (ufoLastSysIncPath
) { free(ufoLastSysIncPath
); ufoLastSysIncPath
= NULL
; }
2366 while (ufoFileStackPos
!= 0) {
2367 ufoFileStackPos
-= 1;
2368 UFOFileStackEntry
*stk
= &ufoFileStack
[ufoFileStackPos
];
2369 if (stk
->fl
) fclose(stk
->fl
);
2370 if (stk
->fname
) free(stk
->fname
);
2371 if (stk
->incpath
) free(stk
->incpath
);
2376 //==========================================================================
2380 //==========================================================================
2381 static void ufoPopInFile (void) {
2382 if (ufoFileStackPos
== 0) ufoFatal("trying to pop include from empty stack");
2383 if (ufoInFileName
) { free(ufoInFileName
); ufoInFileName
= NULL
; }
2384 if (ufoInFile
) { fclose(ufoInFile
); ufoInFile
= NULL
; }
2385 if (ufoLastIncPath
) { free(ufoLastIncPath
); ufoLastIncPath
= NULL
; }
2386 if (ufoLastSysIncPath
) { free(ufoLastSysIncPath
); ufoLastSysIncPath
= NULL
; }
2387 ufoFileStackPos
-= 1;
2388 UFOFileStackEntry
*stk
= &ufoFileStack
[ufoFileStackPos
];
2389 ufoInFile
= stk
->fl
;
2390 ufoSetInFileNameReuse(stk
->fname
);
2391 ufoInFileLine
= stk
->fline
;
2392 ufoLastIncPath
= stk
->incpath
;
2393 ufoLastSysIncPath
= stk
->sysincpath
;
2394 ufoFileId
= stk
->id
;
2396 #ifdef UFO_DEBUG_INCLUDE
2397 if (ufoInFileName
== NULL
) {
2398 fprintf(stderr
, "INC-POP: no more files.\n");
2400 fprintf(stderr
, "INC-POP: fname: %s\n", ufoInFileName
);
2406 //==========================================================================
2410 //==========================================================================
2411 void ufoDeinit (void) {
2412 #ifdef UFO_DEBUG_WRITE_MAIN_IMAGE
2414 FILE *fo
= fopen("zufo_main.img", "w");
2415 const uint32_t dpMain
= ufoImgGetU32(ufoAddrDP
);
2416 fwrite(ufoImage
, dpMain
, 1, fo
);
2421 #ifdef UFO_DEBUG_WRITE_DEBUG_IMAGE
2423 FILE *fo
= fopen("zufo_debug.img", "w");
2424 fwrite(ufoDebugImage
, ufoDebugImageUsed
, 1, fo
);
2429 #ifdef UFO_DEBUG_DEBUG
2431 const uint32_t dpMain
= ufoImgGetU32(ufoAddrDP
);
2432 fprintf(stderr
, "UFO: image used: %u; size: %u\n", dpMain
, ufoImageSize
);
2433 fprintf(stderr
, "UFO: debug image used: %u; size: %u\n", ufoDebugImageUsed
, ufoDebugImageSize
);
2434 ufoDumpDebugImage();
2439 #ifdef UFO_MTASK_ALLOWED
2440 ufoCurrState
= NULL
;
2441 ufoYieldedState
= NULL
;
2442 ufoDebuggerState
= NULL
;
2443 for (uint32_t fidx
= 0; fidx
< (uint32_t)(UFO_MAX_STATES
/32); fidx
+= 1u) {
2444 uint32_t bmp
= ufoStateUsedBitmap
[fidx
];
2446 uint32_t stid
= fidx
* 32u;
2448 if ((bmp
& 0x01) != 0) ufoFreeState(ufoStateMap
[stid
]);
2449 stid
+= 1u; bmp
>>= 1;
2455 free(ufoDebugImage
);
2456 ufoDebugImage
= NULL
;
2457 ufoDebugImageUsed
= 0;
2458 ufoDebugImageSize
= 0;
2459 ufoDebugFileNameHash
= 0;
2460 ufoDebugFileNameLen
= 0;
2461 ufoDebugLastLine
= 0;
2462 ufoDebugLastLinePCOfs
= 0;
2463 ufoDebugLastLineDP
= 0;
2467 ufoClearCondDefines();
2468 ufoWipeIncludeStack();
2470 // release all includes
2472 if (ufoInFileName
) free(ufoInFileName
);
2473 if (ufoLastIncPath
) free(ufoLastIncPath
);
2474 if (ufoLastSysIncPath
) free(ufoLastSysIncPath
);
2475 ufoInFileName
= NULL
; ufoLastIncPath
= NULL
; ufoLastSysIncPath
= NULL
;
2476 ufoInFileNameHash
= 0; ufoInFileNameLen
= 0;
2479 //free(ufoForthCFAs);
2480 //ufoForthCFAs = NULL;
2483 #ifndef UFO_HUGE_IMAGES
2489 ufoMode
= UFO_MODE_NATIVE
;
2490 ufoForthVocId
= 0; ufoCompilerVocId
= 0;
2491 #ifdef UFO_MTASK_ALLOWED
2496 for (uint32_t f
= 0; f
< ufoHandlesUsed
; f
+= 1) {
2497 UfoHandle
*hh
= ufoHandles
[f
];
2499 if (hh
->data
!= NULL
) free(hh
->data
);
2503 if (ufoHandles
!= NULL
) free(ufoHandles
);
2504 ufoHandles
= NULL
; ufoHandlesUsed
= 0; ufoHandlesAlloted
= 0;
2505 ufoHandleFreeList
= NULL
;
2507 ufoLastEmitWasCR
= 1;
2509 ufoClearCondDefines();
2513 //==========================================================================
2515 // ufoDumpWordHeader
2517 //==========================================================================
2518 __attribute__((unused
)) static void ufoDumpWordHeader (const uint32_t lfa
) {
2519 fprintf(stderr
, "=== WORD: LFA: 0x%08x ===\n", lfa
);
2521 fprintf(stderr
, " (XFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_XFA(lfa
)));
2522 fprintf(stderr
, " (YFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_YFA(lfa
)));
2523 fprintf(stderr
, " (BFA): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_BFA(lfa
)));
2524 fprintf(stderr
, " (LFA): 0x%08x\n", ufoImgGetU32(lfa
));
2525 fprintf(stderr
, " (NHH): 0x%08x\n", ufoImgGetU32(UFO_LFA_TO_NHASH(lfa
)));
2526 const uint32_t cfa
= UFO_LFA_TO_CFA(lfa
);
2527 fprintf(stderr
, " CFA: 0x%08x\n", cfa
);
2528 fprintf(stderr
, " PFA: 0x%08x\n", UFO_CFA_TO_PFA(cfa
));
2529 fprintf(stderr
, " (CFA): 0x%08x\n", ufoImgGetU32(cfa
));
2530 const uint32_t nfa
= UFO_LFA_TO_NFA(lfa
);
2531 const uint32_t nlen
= ufoImgGetU8(nfa
);
2532 fprintf(stderr
, " NFA: 0x%08x (nlen: %u)\n", nfa
, nlen
);
2533 const uint32_t flags
= ufoImgGetU32(nfa
);
2534 fprintf(stderr
, " FLAGS: 0x%08x\n", flags
);
2535 if ((flags
& 0xffff0000U
) != 0) {
2536 fprintf(stderr
, " FLAGS:");
2537 if (flags
& UFW_FLAG_IMMEDIATE
) fprintf(stderr
, " IMM");
2538 if (flags
& UFW_FLAG_SMUDGE
) fprintf(stderr
, " SMUDGE");
2539 if (flags
& UFW_FLAG_NORETURN
) fprintf(stderr
, " NORET");
2540 if (flags
& UFW_FLAG_HIDDEN
) fprintf(stderr
, " HIDDEN");
2541 if (flags
& UFW_FLAG_CBLOCK
) fprintf(stderr
, " CBLOCK");
2542 if (flags
& UFW_FLAG_VOCAB
) fprintf(stderr
, " VOCAB");
2543 if (flags
& UFW_FLAG_SCOLON
) fprintf(stderr
, " SCOLON");
2544 if (flags
& UFW_FLAG_PROTECTED
) fprintf(stderr
, " PROTECTED");
2545 if (flags
& UFW_WARG_CONDBRANCH
) fprintf(stderr
, " CONDBRANCH");
2546 if (flags
& UFW_FLAG_MAYRETURN
) fprintf(stderr
, " MAYRETURN");
2547 fputc('\n', stderr
);
2549 if ((flags
& 0xff00U
) != 0) {
2550 fprintf(stderr
, " ARGS: ");
2551 switch (flags
& UFW_WARG_MASK
) {
2552 case UFW_WARG_NONE
: fprintf(stderr
, "NONE"); break;
2553 case UFW_WARG_BRANCH
: fprintf(stderr
, "BRANCH"); break;
2554 case UFW_WARG_LIT
: fprintf(stderr
, "LIT"); break;
2555 case UFW_WARG_C4STRZ
: fprintf(stderr
, "C4STRZ"); break;
2556 case UFW_WARG_CFA
: fprintf(stderr
, "CFA"); break;
2557 case UFW_WARG_CBLOCK
: fprintf(stderr
, "CBLOCK"); break;
2558 case UFW_WARG_VOCID
: fprintf(stderr
, "VOCID"); break;
2559 case UFW_WARG_C1STRZ
: fprintf(stderr
, "C1STRZ"); break;
2560 case UFW_WARG_DATASKIP
: fprintf(stderr
, "DATA"); break;
2561 case UFW_WARG_PFA
: fprintf(stderr
, "PFA"); break;
2562 default: fprintf(stderr
, "wtf?!"); break;
2564 fputc('\n', stderr
);
2566 fprintf(stderr
, " BACKLEN: %u (nfa at 0x%08x)\n", ufoImgGetU8(cfa
- 1u), UFO_CFA_TO_NFA(cfa
));
2567 fprintf(stderr
, " NAME(%u): ", nlen
);
2568 for (uint32_t f
= 0; f
< nlen
; f
+= 1) {
2569 const uint8_t ch
= ufoImgGetU8(nfa
+ 4u + f
);
2570 if (ch
<= 32 || ch
>= 127) {
2571 fprintf(stderr
, "\\x%02x", ch
);
2573 fprintf(stderr
, "%c", (char)ch
);
2576 fprintf(stderr
, "\n");
2577 ufo_assert(UFO_CFA_TO_LFA(cfa
) == lfa
);
2582 //==========================================================================
2588 //==========================================================================
2589 static uint32_t ufoVocCheckName (uint32_t lfa
, const void *wname
, uint32_t wnlen
, uint32_t hash
,
2593 #ifdef UFO_DEBUG_FIND_WORD
2594 fprintf(stderr
, "CHECK-NAME: %.*s; LFA: 0x%08x; hash: 0x%08x (wname: 0x%08x)\n",
2595 (unsigned) wnlen
, (const char *)wname
,
2596 lfa
, (lfa
!= 0 ? ufoImgGetU32(UFO_LFA_TO_NHASH(lfa
)) : 0), hash
);
2597 ufoDumpWordHeader(lfa
);
2599 if (lfa
!= 0 && ufoImgGetU32(UFO_LFA_TO_NHASH(lfa
)) == hash
) {
2600 const uint32_t lenflags
= ufoImgGetU32(UFO_LFA_TO_NFA(lfa
));
2601 if ((lenflags
& UFW_FLAG_SMUDGE
) == 0 &&
2602 (allowvochid
|| (lenflags
& UFW_FLAG_HIDDEN
) == 0))
2604 const uint32_t nlen
= lenflags
&0xffU
;
2605 if (nlen
== wnlen
) {
2606 uint32_t naddr
= UFO_LFA_TO_NFA(lfa
) + 4u;
2608 while (pos
< nlen
) {
2609 uint8_t c0
= ((const unsigned char *)wname
)[pos
];
2610 if (c0
>= 'a' && c0
<= 'z') c0
= c0
- 'a' + 'A';
2611 uint8_t c1
= ufoImgGetU8(naddr
+ pos
);
2612 if (c1
>= 'a' && c1
<= 'z') c1
= c1
- 'a' + 'A';
2613 if (c0
!= c1
) break;
2619 res
= UFO_ALIGN4(naddr
);
2628 //==========================================================================
2634 //==========================================================================
2635 static uint32_t ufoFindWordInVoc (const void *wname
, uint32_t wnlen
, uint32_t hash
,
2636 uint32_t vocid
, int allowvochid
)
2639 if (wname
== NULL
) ufo_assert(wnlen
== 0);
2640 if (wnlen
!= 0 && vocid
!= 0) {
2641 if (hash
== 0) hash
= joaatHashBufCI(wname
, wnlen
);
2642 #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
2643 fprintf(stderr
, "IN-VOC: %.*s; VOCID: 0x%08x; whash: 0x%08x; htbl[0]: 0x%08x\n",
2644 (unsigned) wnlen
, (const char *)wname
,
2645 vocid
, hash
, ufoImgGetU32(vocid
+ UFW_VOCAB_OFS_HTABLE
));
2647 const uint32_t htbl
= vocid
+ UFW_VOCAB_OFS_HTABLE
;
2648 if (ufoImgGetU32(htbl
) != UFO_NO_HTABLE_FLAG
) {
2649 // hash table present, use it
2650 uint32_t bfa
= htbl
+ (hash
% (uint32_t)UFO_HASHTABLE_SIZE
) * 4u;
2651 bfa
= ufoImgGetU32(bfa
);
2652 while (res
== 0 && bfa
!= 0) {
2653 #if defined(UFO_DEBUG_FIND_WORD) || defined(UFO_DEBUG_FIND_WORD_IN_VOC)
2654 fprintf(stderr
, "IN-VOC: bfa: 0x%08x\n", bfa
);
2656 res
= ufoVocCheckName(UFO_BFA_TO_LFA(bfa
), wname
, wnlen
, hash
, allowvochid
);
2657 bfa
= ufoImgGetU32(bfa
);
2660 // no hash table, use linear search
2661 uint32_t lfa
= vocid
+ UFW_VOCAB_OFS_LATEST
;
2662 lfa
= ufoImgGetU32(lfa
);
2663 while (res
== 0 && lfa
!= 0) {
2664 res
= ufoVocCheckName(lfa
, wname
, wnlen
, hash
, allowvochid
);
2665 lfa
= ufoImgGetU32(lfa
);
2673 //==========================================================================
2677 // return part after the colon, or `NULL`
2679 //==========================================================================
2680 static const void *ufoFindColon (const void *wname
, uint32_t wnlen
) {
2681 const void *res
= NULL
;
2683 ufo_assert(wname
!= NULL
);
2684 const char *str
= (const char *)wname
;
2685 while (wnlen
!= 0 && str
[0] != ':') {
2686 str
+= 1; wnlen
-= 1;
2689 res
= (const void *)(str
+ 1); // skip colon
2696 //==========================================================================
2698 // ufoFindWordInVocAndParents
2700 //==========================================================================
2701 static uint32_t ufoFindWordInVocAndParents (const void *wname
, uint32_t wnlen
, uint32_t hash
,
2702 uint32_t vocid
, int allowvochid
)
2705 if (hash
== 0) hash
= joaatHashBufCI(wname
, wnlen
);
2706 while (res
== 0 && vocid
!= 0) {
2707 res
= ufoFindWordInVoc(wname
, wnlen
, hash
, vocid
, allowvochid
);
2708 vocid
= ufoImgGetU32(vocid
+ UFW_VOCAB_OFS_PARENT
);
2714 //==========================================================================
2716 // ufoFindWordNameRes
2718 // find with name resolution
2722 //==========================================================================
2723 static uint32_t ufoFindWordNameRes (const void *wname
, uint32_t wnlen
) {
2725 if (wnlen
!= 0 && *(const char *)wname
!= ':') {
2726 ufo_assert(wname
!= NULL
);
2728 const void *stx
= wname
;
2729 wname
= ufoFindColon(wname
, wnlen
);
2730 if (wname
!= NULL
&& wname
!= stx
+ wnlen
) {
2731 // look in all vocabs (excluding hidden ones)
2732 uint32_t xlen
= (uint32_t)(ptrdiff_t)(wname
- stx
) - 1u;
2733 ufo_assert(xlen
> 0 && xlen
< 255);
2734 uint32_t xhash
= joaatHashBufCI(stx
, xlen
);
2735 uint32_t voclink
= ufoImgGetU32(ufoAddrVocLink
);
2736 #ifdef UFO_DEBUG_FIND_WORD_COLON
2737 fprintf(stderr
, "COLON-FIND: first voc: {%.*s}; xhash=0x%08x; voc-link: 0x%08x\n",
2738 (unsigned)xlen
, (const char *)stx
, xhash
, voclink
);
2740 while (res
== 0 && voclink
!= 0) {
2741 const uint32_t vhdraddr
= voclink
- UFW_VOCAB_OFS_VOCLINK
+ UFW_VOCAB_OFS_HEADER
;
2742 const uint32_t vhdr
= ufoImgGetU32(vhdraddr
);
2744 res
= ufoVocCheckName(UFO_NFA_TO_LFA(vhdr
), stx
, xlen
, xhash
, 0);
2746 if (res
== 0) voclink
= ufoImgGetU32(voclink
);
2749 uint32_t vocid
= voclink
- UFW_VOCAB_OFS_VOCLINK
;
2750 ufo_assert(voclink
!= 0);
2752 #ifdef UFO_DEBUG_FIND_WORD_COLON
2753 fprintf(stderr
, "searching {%.*s}(%u) in {%.*s}\n",
2754 (unsigned)wnlen
, wname
, wnlen
, (unsigned)xlen
, stx
);
2756 while (res
!= 0 && wname
!= NULL
) {
2757 // first, the whole rest
2758 res
= ufoFindWordInVocAndParents(wname
, wnlen
, 0, vocid
, 1);
2763 wname
= ufoFindColon(wname
, wnlen
);
2764 if (wname
== NULL
) xlen
= wnlen
; else xlen
= (uint32_t)(ptrdiff_t)(wname
- stx
) - 1u;
2765 ufo_assert(xlen
> 0 && xlen
< 255);
2766 res
= ufoFindWordInVocAndParents(stx
, xlen
, 0, vocid
, 1);
2769 if (wname
!= NULL
) {
2770 // it should be a vocabulary
2771 const uint32_t nfa
= UFO_CFA_TO_NFA(res
);
2772 if ((ufoImgGetU32(nfa
) & UFW_FLAG_VOCAB
) != 0) {
2773 vocid
= ufoImgGetU32(UFO_CFA_TO_PFA(res
)); // pfa points to vocabulary
2789 //==========================================================================
2793 // doesn't look in CURRENT, does name resolution ("a:b" is word "b" in "a")
2797 //==========================================================================
2798 static uint32_t ufoFindWord (const char *wname
) {
2800 if (wname
&& wname
[0] != 0) {
2801 const size_t wnlen
= strlen(wname
);
2802 ufo_assert(wnlen
< 8192);
2803 uint32_t ctx
= ufoImgGetU32(ufoAddrContext
);
2804 const uint32_t hash
= joaatHashBufCI(wname
, (uint32_t)wnlen
);
2806 //fprintf(stderr, "FIND-WORD: whash: 0x%08x; name:{%s}\n", hash, wname);
2808 // first search in context
2809 res
= ufoFindWordInVocAndParents(wname
, (uint32_t)wnlen
, hash
, ctx
, (ctx
== ufoImgGetU32(ufoAddrCurrent
)));
2811 // now try vocabulary stack
2812 uint32_t vstp
= ufoVSP
;
2813 while (res
== 0 && vstp
!= 0) {
2815 ctx
= ufoVocStack
[vstp
];
2816 res
= ufoFindWordInVocAndParents(wname
, (uint32_t)wnlen
, hash
, ctx
, (ctx
== ufoImgGetU32(ufoAddrCurrent
)));
2819 // if not found, try name resolution
2820 if (res
== 0) res
= ufoFindWordNameRes(wname
, (uint32_t)wnlen
);
2827 //==========================================================================
2829 // ufoCreateWordHeader
2831 // create word header up to CFA, link to the current dictionary
2833 //==========================================================================
2834 static void ufoCreateWordHeader (const char *wname
, uint32_t flags
) {
2835 if (wname
== NULL
) wname
= "";
2836 const size_t wnlen
= strlen(wname
);
2837 ufo_assert(wnlen
< UFO_MAX_WORD_LENGTH
);
2838 const uint32_t hash
= joaatHashBufCI(wname
, (uint32_t)wnlen
);
2839 const uint32_t curr
= ufoImgGetU32(ufoAddrCurrent
);
2840 ufo_assert(curr
!= 0);
2843 const uint32_t warn
= ufoImgGetU32(ufoAddrRedefineWarning
);
2844 if (wnlen
!= 0 && warn
!= UFO_REDEF_WARN_DONT_CARE
) {
2846 if (warn
!= UFO_REDEF_WARN_PARENTS
) {
2847 cfa
= ufoFindWordInVoc(wname
, wnlen
, hash
, curr
, 1);
2849 cfa
= ufoFindWordInVocAndParents(wname
, wnlen
, hash
, curr
, 1);
2852 const uint32_t nfa
= UFO_CFA_TO_NFA(cfa
);
2853 const uint32_t flags
= ufoImgGetU32(nfa
);
2854 if ((flags
& UFW_FLAG_PROTECTED
) != 0) {
2855 ufoFatal("trying to redefine protected word '%s'", wname
);
2856 } else if (warn
!= UFO_REDEF_WARN_NONE
) {
2857 ufoWarning("redefining word '%s'", wname
);
2862 const uint32_t bkt
= (hash
% (uint32_t)UFO_HASHTABLE_SIZE
) * 4u;
2863 const uint32_t htbl
= curr
+ UFW_VOCAB_OFS_HTABLE
;
2866 const uint32_t xfaAddr
= UFO_GET_DP();
2867 if ((xfaAddr
& UFO_ADDR_TEMP_BIT
) == 0) {
2868 // link previous yfa here
2869 const uint32_t lastxfa
= ufoImgGetU32(ufoAddrLastXFA
);
2870 // fix YFA of the previous word (it points to our YFA)
2872 ufoImgPutU32(UFO_XFA_TO_YFA(lastxfa
), UFO_XFA_TO_YFA(xfaAddr
));
2874 // our XFA points to the previous XFA
2875 ufoImgEmitU32(lastxfa
); // xfa
2877 ufoImgPutU32(ufoAddrLastXFA
, xfaAddr
);
2879 ufoImgEmitU32(0); // xfa
2881 ufoImgEmitU32(0); // yfa
2883 // bucket link (bfa)
2884 if (wnlen
== 0 || ufoImgGetU32(htbl
) == UFO_NO_HTABLE_FLAG
) {
2887 #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
2888 fprintf(stderr
, "NEW HEADER: %s; curr: 0x%08x; htbl: 0x%08x; bkt: 0x%08x\n",
2889 wname
, curr
, htbl
, bkt
);
2890 fprintf(stderr
, " [bkt]: 0x%08x; nbk: 0x%08x\n", ufoImgGetU32(htbl
+ bkt
), UFO_GET_DP());
2892 // bfa points to bfa
2893 const uint32_t bfa
= UFO_GET_DP();
2894 ufoImgEmitU32(ufoImgGetU32(htbl
+ bkt
));
2895 ufoImgPutU32(htbl
+ bkt
, bfa
);
2899 const uint32_t lfa
= UFO_GET_DP();
2900 ufoImgEmitU32(ufoImgGetU32(curr
+ UFW_VOCAB_OFS_LATEST
));
2902 ufoImgPutU32(curr
+ UFW_VOCAB_OFS_LATEST
, lfa
);
2904 ufoImgEmitU32(hash
);
2906 const uint32_t nfa
= UFO_GET_DP();
2907 ufoImgEmitU32(((uint32_t)wnlen
&0xffU
) | (flags
& 0xffffff00U
));
2908 const uint32_t nstart
= UFO_GET_DP();
2910 for (size_t f
= 0; f
< wnlen
; f
+= 1) {
2911 ufoImgEmitU8(((const unsigned char *)wname
)[f
]);
2913 while ((UFO_GET_DP() & 3) != 3) ufoImgEmitU8(0);
2914 const uint32_t nend
= UFO_GET_DP(); // length byte itself is not included
2915 // name length, again
2916 ufo_assert(nend
- nstart
<= 255);
2917 ufoImgEmitU8((uint8_t)(nend
- nstart
));
2918 ufo_assert((UFO_GET_DP() & 3) == 0);
2919 ufo_assert(UFO_CFA_TO_NFA(UFO_GET_DP()) == nfa
);
2920 if ((nend
& UFO_ADDR_SPECIAL_BITS_MASK
) == 0) ufoRecordDebug(nend
);
2921 #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
2922 fprintf(stderr
, "*** NEW HEADER ***\n");
2923 fprintf(stderr
, "CFA: 0x%08x\n", UFO_GET_DP());
2924 fprintf(stderr
, "NSTART: 0x%08x\n", nstart
);
2925 fprintf(stderr
, "NEND: 0x%08x\n", nend
);
2926 fprintf(stderr
, "NLEN: %u (%u)\n", nend
- nstart
, ufoImgGetU8(UFO_GET_DP() - 1u));
2927 ufoDumpWordHeader(lfa
);
2930 fprintf(stderr
, "NEW WORD CFA 0x%08x: %s\n", UFO_GET_DP(), wname
);
2935 //==========================================================================
2939 //==========================================================================
2940 static void ufoDecompilePart (uint32_t addr
, uint32_t eaddr
, int indent
) {
2943 while (addr
< eaddr
) {
2944 uint32_t cfa
= ufoImgGetU32(addr
);
2945 for (int n
= 0; n
< indent
; n
+= 1) fputc(' ', fo
);
2946 fprintf(fo
, "%6u: 0x%08x: ", addr
, cfa
);
2947 uint32_t nfa
= UFO_CFA_TO_NFA(cfa
);
2948 uint32_t flags
= ufoImgGetU32(nfa
);
2949 //fprintf(fo, "[0x%08x] ", flags & UFW_WARG_MASK);
2950 uint32_t nlen
= flags
& 0xffU
;
2951 for (uint32_t f
= 0; f
< nlen
; f
+= 1) {
2952 const uint8_t ch
= ufoImgGetU8(nfa
+ 4u + f
);
2953 if (ch
<= 32 || ch
>= 127) {
2954 fprintf(fo
, "\\x%02x", ch
);
2956 fprintf(fo
, "%c", (char)ch
);
2960 switch (flags
& UFW_WARG_MASK
) {
2963 case UFW_WARG_BRANCH
:
2964 #ifdef UFO_RELATIVE_BRANCH
2965 fprintf(fo
, " @%u", addr
+ ufoImgGetU32(addr
)); addr
+= 4u;
2967 fprintf(fo
, " @%u", ufoImgGetU32(addr
)); addr
+= 4u;
2971 fprintf(fo
, " %u : %d : 0x%08x", ufoImgGetU32(addr
),
2972 (int32_t)ufoImgGetU32(addr
), ufoImgGetU32(addr
)); addr
+= 4u;
2974 case UFW_WARG_C4STRZ
:
2975 count
= ufoImgGetU32(addr
); addr
+= 4;
2977 fprintf(fo
, " str:");
2978 for (int f
= 0; f
< count
; f
+= 1) {
2979 const uint8_t ch
= ufoImgGetU8(addr
); addr
+= 1u;
2980 if (ch
<= 32 || ch
>= 127) {
2981 fprintf(fo
, "\\x%02x", ch
);
2983 fprintf(fo
, "%c", (char)ch
);
2986 addr
+= 1u; // skip zero byte
2987 addr
= UFO_ALIGN4(addr
);
2990 cfa
= ufoImgGetU32(addr
); addr
+= 4u;
2991 fprintf(fo
, " CFA:%u: ", cfa
);
2992 nfa
= UFO_CFA_TO_NFA(cfa
);
2993 nlen
= ufoImgGetU8(nfa
);
2994 for (uint32_t f
= 0; f
< nlen
; f
+= 1) {
2995 const uint8_t ch
= ufoImgGetU8(nfa
+ 4u + f
);
2996 if (ch
<= 32 || ch
>= 127) {
2997 fprintf(fo
, "\\x%02x", ch
);
2999 fprintf(fo
, "%c", (char)ch
);
3004 cfa
= ufoImgGetU32(addr
); addr
+= 4u;
3005 fprintf(fo
, " PFA:%u: ", cfa
);
3006 cfa
= UFO_PFA_TO_CFA(cfa
);
3007 nfa
= UFO_CFA_TO_NFA(cfa
);
3008 nlen
= ufoImgGetU8(nfa
);
3009 for (uint32_t f
= 0; f
< nlen
; f
+= 1) {
3010 const uint8_t ch
= ufoImgGetU8(nfa
+ 4u + f
);
3011 if (ch
<= 32 || ch
>= 127) {
3012 fprintf(fo
, "\\x%02x", ch
);
3014 fprintf(fo
, "%c", (char)ch
);
3018 case UFW_WARG_CBLOCK
:
3019 fprintf(fo
, " CBLOCK:%u", ufoImgGetU32(addr
)); addr
+= 4u;
3021 case UFW_WARG_VOCID
:
3022 fprintf(fo
, " VOCID:%u", ufoImgGetU32(addr
)); addr
+= 4u;
3024 case UFW_WARG_C1STRZ
:
3025 count
= ufoImgGetU8(addr
); addr
+= 1;
3027 case UFW_WARG_DATASKIP
:
3028 fprintf(fo
, " DATA:%u", ufoImgGetU32(addr
));
3029 addr
+= UFO_ALIGN4(4u + ufoImgGetU32(addr
));
3032 fprintf(fo
, " -- WTF?!\n");
3040 //==========================================================================
3044 //==========================================================================
3045 static void ufoDecompileWord (const uint32_t cfa
) {
3047 const uint32_t lfa
= UFO_CFA_TO_LFA(cfa
);
3048 fprintf(stdout
, "#### DECOMPILING CFA %u ###\n", cfa
);
3049 ufoDumpWordHeader(lfa
);
3050 const uint32_t yfa
= ufoGetWordEndAddr(cfa
);
3051 if (ufoImgGetU32(cfa
) == ufoDoForthCFA
) {
3052 fprintf(stdout
, "--- DECOMPILED CODE ---\n");
3053 ufoDecompilePart(UFO_CFA_TO_PFA(cfa
), yfa
, 0);
3054 fprintf(stdout
, "=======================\n");
3060 //==========================================================================
3062 // ufoBTShowWordName
3064 //==========================================================================
3065 static void ufoBTShowWordName (uint32_t nfa
) {
3067 uint32_t len
= ufoImgGetU8(nfa
); nfa
+= 4u;
3068 //fprintf(stderr, "(0x%08x)", ufoImgGetU32(nfa - 4u));
3070 uint8_t ch
= ufoImgGetU8(nfa
); nfa
+= 1u; len
-= 1u;
3071 if (ch
<= 32 || ch
>= 127) {
3072 fprintf(stderr
, "\\x%02x", ch
);
3074 fprintf(stderr
, "%c", (char)ch
);
3081 //==========================================================================
3085 //==========================================================================
3086 static void ufoBacktrace (uint32_t ip
, int showDataStack
) {
3087 // dump data stack (top 16)
3089 if (!ufoLastEmitWasCR
) { printf("\n"); ufoLastEmitWasCR
= 1; }
3091 if (showDataStack
) {
3092 fprintf(stderr
, "***UFO STACK DEPTH: %u\n", ufoSP
);
3093 uint32_t xsp
= ufoSP
;
3094 if (xsp
> 16) xsp
= 16;
3095 for (uint32_t sp
= 0; sp
< xsp
; ++sp
) {
3096 fprintf(stderr
, " %2u: 0x%08x %d%s\n",
3097 sp
, ufoDStack
[xsp
- sp
- 1], (int32_t)ufoDStack
[xsp
- sp
- 1],
3098 (sp
== 0 ? " -- TOS" : ""));
3100 if (ufoSP
> 16) fprintf(stderr
, " ...more...\n");
3103 // dump return stack (top 32)
3108 fprintf(stderr
, "***UFO RETURN STACK DEPTH: %u\n", ufoRP
);
3110 nfa
= ufoFindWordForIP(ip
);
3112 fprintf(stderr
, " **: %8u -- ", ip
);
3113 ufoBTShowWordName(nfa
);
3114 fname
= ufoFindFileForIP(ip
, &fline
, NULL
, NULL
);
3115 if (fname
!= NULL
) { fprintf(stderr
, " (at %s:%u)", fname
, fline
); }
3116 fputc('\n', stderr
);
3119 uint32_t rp
= ufoRP
;
3120 uint32_t rscount
= 0;
3121 if (rp
> UFO_RSTACK_SIZE
) rp
= UFO_RSTACK_SIZE
;
3122 while (rscount
!= 32 && rp
!= 0) {
3124 const uint32_t val
= ufoRStack
[rp
];
3125 nfa
= ufoFindWordForIP(val
- 4u);
3127 fprintf(stderr
, " %2u: %8u -- ", ufoRP
- rp
- 1u, val
);
3128 ufoBTShowWordName(nfa
);
3129 fname
= ufoFindFileForIP(val
- 4u, &fline
, NULL
, NULL
);
3130 if (fname
!= NULL
) { fprintf(stderr
, " (at %s:%u)", fname
, fline
); }
3131 fputc('\n', stderr
);
3133 fprintf(stderr
, " %2u: 0x%08x %d\n", ufoRP
- rp
- 1u, val
, (int32_t)val
);
3137 if (ufoRP
> 32) fprintf(stderr
, " ...more...\n");
3143 //==========================================================================
3147 //==========================================================================
3149 static void ufoDumpVocab (uint32_t vocid) {
3151 fprintf(stderr, "*** VOCID: 0x%08x ***\n", vocid);
3152 uint32_t vochdr = vocid + UFW_VOCAB_OFS_HEADER;
3153 vochdr = ufoImgGetU32(vochdr);
3155 fprintf(stderr, "--- HEADER ---\n");
3156 ufoDumpWordHeader(UFO_NFA_TO_LFA(vochdr));
3157 fprintf(stderr, "========\n");
3158 uint32_t htbl = vocid + UFW_VOCAB_OFS_HTABLE;
3159 if (ufoImgGetU32(htbl) != UFO_NO_HTABLE_FLAG) {
3160 fprintf(stderr, "--- HASH TABLE ---\n");
3161 for (int f = 0; f < UFO_HASHTABLE_SIZE; f += 1) {
3162 uint32_t bfa = ufoImgGetU32(htbl);
3164 fprintf(stderr, "**** %2d: 0x%08x\n", f, bfa);
3166 ufoDumpWordHeader(UFO_BFA_TO_LFA(bfa));
3167 bfa = ufoImgGetU32(bfa);
3179 // if set, this will be used when we are out of include files. intended for UrAsm.
3180 // return 0 if there is no more lines, otherwise the string should be copied
3181 // to buffer, `*fname` and `*fline` should be properly set.
3182 int (*ufoFileReadLine
) (void *buf
, size_t bufsize
, const char **fname
, int *fline
) = NULL
;
3185 //==========================================================================
3187 // ufoLoadNextUserLine
3189 //==========================================================================
3190 static int ufoLoadNextUserLine (void) {
3191 uint32_t tibPos
= 0;
3192 const char *fname
= NULL
;
3195 if (ufoFileReadLine
!= NULL
&& ufoFileReadLine(ufoCurrFileLine
, 510, &fname
, &fline
) != 0) {
3196 ufoCurrFileLine
[510] = 0;
3197 uint32_t slen
= (uint32_t)strlen(ufoCurrFileLine
);
3198 while (slen
!= 0 && (ufoCurrFileLine
[slen
- 1u] == 10 || ufoCurrFileLine
[slen
- 1u] == 13)) {
3201 if (tibPos
+ slen
+ 1u > UFO_ADDR_HANDLE_OFS_MASK
) {
3202 ufoFatal("input text line too long (at least %u bytes)", tibPos
+ slen
);
3204 ufoTibEnsureSize(tibPos
+ slen
+ 1u);
3205 for (uint32_t f
= 0; f
< slen
; f
+= 1) {
3206 ufoTibPokeChOfs(((const unsigned char *)ufoCurrFileLine
)[f
], tibPos
+ f
);
3208 ufoTibPokeChOfs(0, tibPos
+ slen
);
3210 if (fname
== NULL
) fname
= "<user>";
3211 ufoSetInFileName(fname
);
3212 ufoInFileLine
= fline
;
3220 //==========================================================================
3222 // ufoLoadNextLine_NativeMode
3224 // load next file line into TIB
3225 // always strips final '\n'
3227 // return 0 on EOF, 1 on success
3229 //==========================================================================
3230 static int ufoLoadNextLine (int crossInclude
) {
3232 uint32_t tibPos
= 0;
3235 if (ufoMode
== UFO_MODE_MACRO
) {
3236 //fprintf(stderr, "***MAC!\n");
3240 while (ufoInFile
!= NULL
&& !done
) {
3241 ufoCurrIncludeLineFileOfs
= ftell(ufoInFile
);
3242 if (fgets(ufoCurrFileLine
, 510, ufoInFile
) != NULL
) {
3243 // check for a newline
3244 // if there is no newline char at the end, the string was truncated
3245 ufoCurrFileLine
[510] = 0;
3246 const uint32_t slen
= (uint32_t)strlen(ufoCurrFileLine
);
3247 if (tibPos
+ slen
+ 1u > UFO_ADDR_HANDLE_OFS_MASK
) {
3248 ufoFatal("input text line too long (at least %u bytes)", tibPos
+ slen
);
3250 ufoTibEnsureSize(tibPos
+ slen
+ 1u);
3251 for (uint32_t f
= 0; f
< slen
; f
+= 1) {
3252 ufoTibPokeChOfs(((const unsigned char *)ufoCurrFileLine
)[f
], tibPos
+ f
);
3254 ufoTibPokeChOfs(0, tibPos
+ slen
);
3256 if (slen
!= 0 && (ufoCurrFileLine
[slen
- 1u] == 13 || ufoCurrFileLine
[slen
- 1u] == 10)) {
3260 // continuation, nothing to do
3263 // if we read nothing, this is EOF
3264 if (tibPos
== 0 && crossInclude
) {
3265 // we read nothing, and allowed to cross include boundaries
3274 // eof, try user-supplied input
3275 if (ufoFileStackPos
== 0) {
3276 return ufoLoadNextUserLine();
3281 // if we read at least something, this is not EOF
3287 // ////////////////////////////////////////////////////////////////////////// //
3292 UFWORD(DUMP_STACK
) {
3293 if (!ufoLastEmitWasCR
) { printf("\n"); ufoLastEmitWasCR
= 1; }
3294 printf("***UFO STACK DEPTH: %u\n", ufoSP
);
3295 uint32_t xsp
= ufoSP
;
3296 if (xsp
> 16) xsp
= 16;
3297 for (uint32_t sp
= 0; sp
< xsp
; ++sp
) {
3298 printf(" %2u: 0x%08x %d%s\n",
3299 sp
, ufoDStack
[xsp
- sp
- 1], (int32_t)ufoDStack
[xsp
- sp
- 1],
3300 (sp
== 0 ? " -- TOS" : ""));
3302 if (ufoSP
> 16) printf(" ...more...\n");
3303 ufoLastEmitWasCR
= 1;
3308 UFWORD(UFO_BACKTRACE
) {
3310 if (!ufoLastEmitWasCR
) { printf("\n"); ufoLastEmitWasCR
= 1; }
3311 if (ufoInFile
!= NULL
) {
3312 fprintf(stderr
, "*** at file %s, line %d ***\n", ufoInFileName
, ufoInFileLine
);
3314 fprintf(stderr
, "*** somewhere in time ***\n");
3316 ufoBacktrace(ufoIP
, 1);
3319 #ifdef UFO_MTASK_ALLOWED
3322 UFWORD(DUMP_STACK_TASK
) {
3323 UfoState
*st
= ufoFindState(ufoPop());
3324 if (st
== NULL
) ufoFatal("invalid state id");
3325 // temporarily switch the task
3326 UfoState
*oldst
= ufoCurrState
; ufoCurrState
= st
;
3328 if (!ufoLastEmitWasCR
) { printf("\n"); ufoLastEmitWasCR
= 1; }
3329 printf("***UFO STACK DEPTH: %u\n", ufoSP
);
3330 uint32_t xsp
= ufoSP
;
3331 if (xsp
> 16) xsp
= 16;
3332 for (uint32_t sp
= 0; sp
< xsp
; ++sp
) {
3333 printf(" %2u: 0x%08x %d%s\n",
3334 sp
, ufoDStack
[xsp
- sp
- 1], (int32_t)ufoDStack
[xsp
- sp
- 1],
3335 (sp
== 0 ? " -- TOS" : ""));
3337 if (ufoSP
> 16) printf(" ...more...\n");
3338 ufoLastEmitWasCR
= 1;
3340 ufoCurrState
= oldst
;
3345 UFWORD(DUMP_RSTACK_TASK
) {
3346 UfoState
*st
= ufoFindState(ufoPop());
3347 if (st
== NULL
) ufoFatal("invalid state id");
3348 // temporarily switch the task
3349 UfoState
*oldst
= ufoCurrState
; ufoCurrState
= st
;
3352 if (!ufoLastEmitWasCR
) { printf("\n"); ufoLastEmitWasCR
= 1; }
3353 if (ufoInFile
!= NULL
) {
3354 fprintf(stderr
, "*** at file %s, line %d ***\n", ufoInFileName
, ufoInFileLine
);
3356 fprintf(stderr
, "*** somewhere in time ***\n");
3358 ufoBacktrace(ufoIP
, 0);
3360 ufoCurrState
= oldst
;
3365 UFWORD(UFO_BACKTRACE_TASK
) {
3366 UfoState
*st
= ufoFindState(ufoPop());
3367 if (st
== NULL
) ufoFatal("invalid state id");
3368 // temporarily switch the task
3369 UfoState
*oldst
= ufoCurrState
; ufoCurrState
= st
;
3372 if (!ufoLastEmitWasCR
) { printf("\n"); ufoLastEmitWasCR
= 1; }
3373 if (ufoInFile
!= NULL
) {
3374 fprintf(stderr
, "*** at file %s, line %d ***\n", ufoInFileName
, ufoInFileLine
);
3376 fprintf(stderr
, "*** somewhere in time ***\n");
3378 ufoBacktrace(ufoIP
, 1);
3380 ufoCurrState
= oldst
;
3385 // ////////////////////////////////////////////////////////////////////////// //
3386 // some init words, and PAD
3395 UFWORD(PAR_NOTIMPL
) {
3396 ufoFatal("not implemented");
3401 UFWORD(SP0_STORE
) { ufoSP
= 0; }
3411 // PAD is at the beginning of temp area
3413 ufoPush(UFO_PAD_ADDR
);
3419 ufoPush(UFO_GET_DP());
3424 UFWORD(ALIGN_HERE
) {
3429 // ////////////////////////////////////////////////////////////////////////// //
3430 // peeks and pokes with address register
3441 UFWORD(REGA_STORE
) {
3449 const uint32_t newa
= ufoPop();
3462 UFWORD(REGA_INC_WORD
) {
3468 UFWORD(REGA_INC_CELL
) {
3480 UFWORD(REGA_DEC_WORD
) {
3486 UFWORD(REGA_DEC_CELL
) {
3499 ufoRegA
= ufoRPop();
3503 // ////////////////////////////////////////////////////////////////////////// //
3504 // useful to work with handles and normal addreses uniformly
3509 UFWORD(CPEEK_REGA
) {
3510 ufoPush(ufoImgGetU8(ufoRegA
));
3515 UFWORD(WPEEK_REGA
) {
3516 ufoPush(ufoImgGetU16(ufoRegA
));
3522 ufoPush(ufoImgGetU32(ufoRegA
));
3527 UFWORD(CPOKE_REGA
) {
3528 ufoImgPutU8(ufoRegA
, ufoPop());
3533 UFWORD(WPOKE_REGA
) {
3534 ufoImgPutU16(ufoRegA
, ufoPop());
3540 ufoImgPutU32(ufoRegA
, ufoPop());
3545 UFWORD(CPEEK_REGA_IDX
) {
3546 if ((ufoRegA
& UFO_ADDR_HANDLE_BIT
) == 0) {
3548 const uint32_t newaddr
= ufoRegA
+ UFO_TOS
;
3549 if ((ufoRegA
& UFO_ADDR_SPECIAL_BITS_MASK
) == (newaddr
& UFO_ADDR_SPECIAL_BITS_MASK
)) {
3550 UFO_TOS
= ufoImgGetU8(newaddr
);
3552 ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3553 ufoRegA
, UFO_TOS
, newaddr
);
3557 UFCALL(PAR_HANDLE_LOAD_BYTE
);
3563 UFWORD(WPEEK_REGA_IDX
) {
3564 if ((ufoRegA
& UFO_ADDR_HANDLE_BIT
) == 0) {
3566 const uint32_t newaddr
= ufoRegA
+ UFO_TOS
;
3567 if ((ufoRegA
& UFO_ADDR_SPECIAL_BITS_MASK
) == (newaddr
& UFO_ADDR_SPECIAL_BITS_MASK
) &&
3568 (ufoRegA
& UFO_ADDR_SPECIAL_BITS_MASK
) == ((newaddr
+ 1u) & UFO_ADDR_SPECIAL_BITS_MASK
))
3570 UFO_TOS
= ufoImgGetU16(newaddr
);
3572 ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3573 ufoRegA
, UFO_TOS
, newaddr
);
3577 UFCALL(PAR_HANDLE_LOAD_WORD
);
3583 UFWORD(PEEK_REGA_IDX
) {
3584 if ((ufoRegA
& UFO_ADDR_HANDLE_BIT
) == 0) {
3586 const uint32_t newaddr
= ufoRegA
+ UFO_TOS
;
3587 if ((ufoRegA
& UFO_ADDR_SPECIAL_BITS_MASK
) == (newaddr
& UFO_ADDR_SPECIAL_BITS_MASK
) &&
3588 (ufoRegA
& UFO_ADDR_SPECIAL_BITS_MASK
) == ((newaddr
+ 3u) & UFO_ADDR_SPECIAL_BITS_MASK
))
3590 UFO_TOS
= ufoImgGetU32(newaddr
);
3592 ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3593 ufoRegA
, UFO_TOS
, newaddr
);
3597 UFCALL(PAR_HANDLE_LOAD_CELL
);
3603 UFWORD(CPOKE_REGA_IDX
) {
3604 if ((ufoRegA
& UFO_ADDR_HANDLE_BIT
) == 0) {
3605 const uint32_t idx
= ufoPop();
3606 const uint32_t newaddr
= ufoRegA
+ idx
;
3607 if ((ufoRegA
& UFO_ADDR_SPECIAL_BITS_MASK
) == (newaddr
& UFO_ADDR_SPECIAL_BITS_MASK
)) {
3608 const uint32_t value
= ufoPop();
3609 ufoImgPutU8(newaddr
, value
);
3611 ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3612 ufoRegA
, idx
, newaddr
);
3616 UFCALL(PAR_HANDLE_STORE_BYTE
);
3622 UFWORD(WPOKE_REGA_IDX
) {
3623 if ((ufoRegA
& UFO_ADDR_HANDLE_BIT
) == 0) {
3624 const uint32_t idx
= ufoPop();
3625 const uint32_t newaddr
= ufoRegA
+ idx
;
3626 if ((ufoRegA
& UFO_ADDR_SPECIAL_BITS_MASK
) == (newaddr
& UFO_ADDR_SPECIAL_BITS_MASK
) &&
3627 (ufoRegA
& UFO_ADDR_SPECIAL_BITS_MASK
) == ((newaddr
+ 1u) & UFO_ADDR_SPECIAL_BITS_MASK
))
3629 const uint32_t value
= ufoPop();
3630 ufoImgPutU16(newaddr
, value
);
3632 ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3633 ufoRegA
, idx
, newaddr
);
3637 UFCALL(PAR_HANDLE_STORE_WORD
);
3643 UFWORD(POKE_REGA_IDX
) {
3644 if ((ufoRegA
& UFO_ADDR_HANDLE_BIT
) == 0) {
3645 const uint32_t idx
= ufoPop();
3646 const uint32_t newaddr
= ufoRegA
+ idx
;
3647 if ((ufoRegA
& UFO_ADDR_SPECIAL_BITS_MASK
) == (newaddr
& UFO_ADDR_SPECIAL_BITS_MASK
) &&
3648 (ufoRegA
& UFO_ADDR_SPECIAL_BITS_MASK
) == ((newaddr
+ 3u) & UFO_ADDR_SPECIAL_BITS_MASK
))
3650 const uint32_t value
= ufoPop();
3651 ufoImgPutU32(newaddr
, value
);
3653 ufoFatal("address offset out of range; addr=0x%08x; offset=%u; res=0x%08x",
3654 ufoRegA
, idx
, newaddr
);
3658 UFCALL(PAR_HANDLE_STORE_CELL
);
3664 UFWORD(CPOKE_REGA_INC1
) {
3665 ufoImgPutU8(ufoRegA
, ufoPop());
3671 UFWORD(WPOKE_REGA_INC2
) {
3672 ufoImgPutU16(ufoRegA
, ufoPop());
3678 UFWORD(POKE_REGA_INC4
) {
3679 ufoImgPutU32(ufoRegA
, ufoPop());
3685 UFWORD(CPEEK_REGA_INC1
) {
3686 ufoPush(ufoImgGetU8(ufoRegA
));
3692 UFWORD(WPEEK_REGA_INC2
) {
3693 ufoPush(ufoImgGetU16(ufoRegA
));
3699 UFWORD(PEEK_REGA_INC4
) {
3700 ufoPush(ufoImgGetU32(ufoRegA
));
3705 // ////////////////////////////////////////////////////////////////////////// //
3712 const uint32_t cfa
= ufoPop();
3717 // ( destaddr addr -- )
3718 // write "branch to destaddr" address to addr
3719 UFWORD(PAR_BRANCH_ADDR_POKE
) {
3720 const uint32_t addr
= ufoPop();
3721 const uint32_t dest
= ufoPop();
3722 #ifdef UFO_RELATIVE_BRANCH
3723 ufoImgPutU32(addr
, dest
- addr
);
3725 ufoImgPutU32(addr
, dest
);
3731 // read branch address
3732 UFWORD(PAR_BRANCH_ADDR_PEEK
) {
3734 #ifdef UFO_RELATIVE_BRANCH
3735 UFO_TOS
+= ufoImgGetU32(UFO_TOS
);
3737 UFO_TOS
= ufoImgGetU32(UFO_TOS
);
3742 // ( addr -- value8 )
3745 UFO_TOS
= ufoImgGetU8(UFO_TOS
);
3749 // ( addr -- value16 )
3752 UFO_TOS
= ufoImgGetU16(UFO_TOS
);
3756 // ( addr -- value32 )
3759 UFO_TOS
= ufoImgGetU32(UFO_TOS
);
3766 ufoImgPutU8(UFO_TOS
, UFO_S(1));
3771 // ( val16 addr -- )
3774 ufoImgPutU16(UFO_TOS
, UFO_S(1));
3779 // ( val32 addr -- )
3782 ufoImgPutU32(UFO_TOS
, UFO_S(1));
3788 // code arg is address
3789 UFWORD(DIRECT_PEEK
) {
3790 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3791 ufoPush(ufoImgGetU32(addr
));
3796 // code arg is address
3797 UFWORD(DIRECT_POKE0
) {
3798 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3799 ufoImgPutU32(addr
, 0);
3804 // code arg is address
3805 UFWORD(DIRECT_POKE1
) {
3806 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3807 ufoImgPutU32(addr
, 1);
3812 // code arg is address
3813 UFWORD(DIRECT_POKEM1
) {
3814 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3815 ufoImgPutU32(addr
, ~(uint32_t)0);
3820 // code arg is address
3821 UFWORD(DIRECT_POKE
) {
3822 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3823 const uint32_t val
= ufoPop();
3824 ufoImgPutU32(addr
, val
);
3829 // code arg is address
3830 UFWORD(DIRECT_ADD_POKE
) {
3831 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3832 uint32_t val
= ufoPop();
3833 val
+= ufoImgGetU32(addr
);
3834 ufoImgPutU32(addr
, val
);
3839 // code arg is address
3840 UFWORD(DIRECT_SUB_POKE
) {
3841 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3842 uint32_t val
= ufoPop();
3843 val
-= ufoImgGetU32(addr
);
3844 ufoImgPutU32(addr
, val
);
3848 // ( addr -- value32 )
3849 // code arg is offset
3850 UFWORD(DIRECT_OFS_PEEK
) {
3852 const uint32_t addr
= UFO_TOS
+ ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3853 UFO_TOS
= ufoImgGetU32(addr
);
3857 // ( value32 addr -- )
3858 // code arg is offset
3859 UFWORD(DIRECT_OFS_POKE
) {
3861 const uint32_t addr
= UFO_TOS
+ ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3862 ufoImgPutU32(addr
, UFO_S(1));
3868 // code arg is address
3869 UFWORD(DIRECT_POKE_INC1
) {
3870 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3871 const uint32_t val
= ufoImgGetU32(addr
);
3872 ufoImgPutU32(addr
, val
+ 1u);
3877 // code arg is address
3878 UFWORD(DIRECT_POKE_INC2
) {
3879 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3880 const uint32_t val
= ufoImgGetU32(addr
);
3881 ufoImgPutU32(addr
, val
+ 2u);
3886 // code arg is address
3887 UFWORD(DIRECT_POKE_INC4
) {
3888 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3889 const uint32_t val
= ufoImgGetU32(addr
);
3890 ufoImgPutU32(addr
, val
+ 4u);
3895 // code arg is address
3896 UFWORD(DIRECT_POKE_INC8
) {
3897 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3898 const uint32_t val
= ufoImgGetU32(addr
);
3899 ufoImgPutU32(addr
, val
+ 8u);
3904 // code arg is address
3905 UFWORD(DIRECT_POKE_DEC1
) {
3906 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3907 const uint32_t val
= ufoImgGetU32(addr
);
3908 ufoImgPutU32(addr
, val
- 1u);
3913 // code arg is address
3914 UFWORD(DIRECT_POKE_DEC2
) {
3915 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3916 const uint32_t val
= ufoImgGetU32(addr
);
3917 ufoImgPutU32(addr
, val
- 2u);
3922 // code arg is address
3923 UFWORD(DIRECT_POKE_DEC4
) {
3924 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3925 const uint32_t val
= ufoImgGetU32(addr
);
3926 ufoImgPutU32(addr
, val
- 4u);
3931 // code arg is address
3932 UFWORD(DIRECT_POKE_DEC8
) {
3933 const uint32_t addr
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
3934 const uint32_t val
= ufoImgGetU32(addr
);
3935 ufoImgPutU32(addr
, val
- 8u);
3939 // ( addr value -- )
3940 UFWORD(SWAP_CPOKE
) {
3942 ufoImgPutU8(UFO_S(1), UFO_TOS
);
3947 // ( addr value -- )
3948 UFWORD(SWAP_WPOKE
) {
3950 ufoImgPutU16(UFO_S(1), UFO_TOS
);
3955 // ( addr value -- )
3958 ufoImgPutU32(UFO_S(1), UFO_TOS
);
3963 // ( value addr -- )
3966 ufoImgPutU8(UFO_TOS
, UFO_S(1) | ufoImgGetU8(UFO_TOS
));
3971 // ( value addr -- )
3974 ufoImgPutU16(UFO_TOS
, UFO_S(1) | ufoImgGetU16(UFO_TOS
));
3979 // ( value addr -- )
3982 #ifdef UFO_FAST_MEM_ACCESS
3983 if ((UFO_TOS
& UFO_ADDR_HANDLE_BIT
) == 0) {
3984 uint32_t *uptr
= ufoImgIOPtrU32(UFO_TOS
);
3987 ufoImgPutU32(UFO_TOS
, UFO_S(1) | ufoImgGetU32(UFO_TOS
));
3990 ufoImgPutU32(UFO_TOS
, UFO_S(1) | ufoImgGetU32(UFO_TOS
));
3996 // ( value addr -- )
3999 ufoImgPutU8(UFO_TOS
, UFO_S(1) ^ ufoImgGetU8(UFO_TOS
));
4004 // ( value addr -- )
4007 ufoImgPutU16(UFO_TOS
, UFO_S(1) ^ ufoImgGetU16(UFO_TOS
));
4012 // ( value addr -- )
4015 #ifdef UFO_FAST_MEM_ACCESS
4016 if ((UFO_TOS
& UFO_ADDR_HANDLE_BIT
) == 0) {
4017 uint32_t *uptr
= ufoImgIOPtrU32(UFO_TOS
);
4020 ufoImgPutU32(UFO_TOS
, UFO_S(1) ^ ufoImgGetU32(UFO_TOS
));
4023 ufoImgPutU32(UFO_TOS
, UFO_S(1) ^ ufoImgGetU32(UFO_TOS
));
4029 // ( value addr -- )
4030 UFWORD(NAND_CPOKE
) {
4032 ufoImgPutU8(UFO_TOS
, ufoImgGetU8(UFO_TOS
) & ~UFO_S(1));
4037 // ( value addr -- )
4038 UFWORD(NAND_WPOKE
) {
4040 ufoImgPutU16(UFO_TOS
, ufoImgGetU16(UFO_TOS
) & ~UFO_S(1));
4045 // ( value addr -- )
4048 #ifdef UFO_FAST_MEM_ACCESS
4049 if ((UFO_TOS
& UFO_ADDR_HANDLE_BIT
) == 0) {
4050 uint32_t *uptr
= ufoImgIOPtrU32(UFO_TOS
);
4051 *uptr
= *uptr
& ~UFO_S(1);
4053 ufoImgPutU32(UFO_TOS
, ufoImgGetU32(UFO_TOS
) & ~UFO_S(1));
4056 ufoImgPutU32(UFO_TOS
, ufoImgGetU32(UFO_TOS
) & ~UFO_S(1));
4062 // ( addr -- addr+4 addr@ )
4065 const uint32_t count
= ufoImgGetU32(UFO_TOS
);
4071 // ( addr -- addr+4 addr@&0xff )
4074 const uint32_t count
= ufoImgGetU32(UFO_TOS
);
4076 ufoPush(count
& 0xffU
);
4080 // ( addr -- addr+1 addrC@ )
4083 const uint32_t count
= ufoImgGetU8(UFO_TOS
);
4091 ufoImgPutU32(ufoPop(), 0);
4097 ufoImgPutU32(ufoPop(), 1);
4102 UFWORD(POKE_INC_1
) {
4103 const uint32_t addr
= ufoPop();
4104 const uint32_t val
= ufoImgGetU32(addr
);
4105 ufoImgPutU32(addr
, val
+ 1u);
4110 UFWORD(POKE_DEC_1
) {
4111 const uint32_t addr
= ufoPop();
4112 const uint32_t val
= ufoImgGetU32(addr
);
4113 ufoImgPutU32(addr
, val
- 1u);
4117 // ( delta addr -- )
4120 ufoImgPutU32(UFO_TOS
, ufoImgGetU32(UFO_TOS
) + UFO_S(1));
4125 // ( delta addr -- )
4128 ufoImgPutU32(UFO_TOS
, ufoImgGetU32(UFO_TOS
) - UFO_S(1));
4133 // ////////////////////////////////////////////////////////////////////////// //
4134 // dictionary emitters
4139 UFWORD(CCOMMA
) { const uint32_t val
= ufoPop(); ufoImgEmitU8(val
); }
4143 UFWORD(WCOMMA
) { const uint32_t val
= ufoPop(); ufoImgEmitU16(val
); }
4147 UFWORD(COMMA
) { const uint32_t val
= ufoPop(); ufoImgEmitU32(val
); }
4150 // ////////////////////////////////////////////////////////////////////////// //
4156 const uint32_t v
= ufoImgGetU32(ufoIP
); ufoIP
+= 4;
4160 // (LITCFA) ( -- n )
4161 UFWORD(PAR_LITCFA
) {
4162 const uint32_t v
= ufoImgGetU32(ufoIP
); ufoIP
+= 4;
4166 // (LITPFA) ( -- n )
4167 UFWORD(PAR_LITPFA
) {
4168 const uint32_t v
= ufoImgGetU32(ufoIP
); ufoIP
+= 4;
4172 // (LITVOCID) ( -- n )
4173 UFWORD(PAR_LITVOCID
) {
4174 const uint32_t v
= ufoImgGetU32(ufoIP
); ufoIP
+= 4;
4179 UFWORD(PAR_LITSTR8
) {
4180 const uint32_t count
= ufoImgGetU8(ufoIP
); ufoIP
+= 1;
4183 ufoIP
+= count
+ 1; // 1 for terminating 0
4184 ufoIP
= UFO_ALIGN4(ufoIP
);
4188 // ////////////////////////////////////////////////////////////////////////// //
4192 #ifdef UFO_RELATIVE_BRANCH
4193 # define UFO_IP_BRANCH() (ufoIP += ufoImgGetU32(ufoIP))
4195 # define UFO_IP_BRANCH() (ufoIP = ufoImgGetU32(ufoIP))
4199 UFWORD(PAR_BRANCH
) {
4203 // (TBRANCH) ( flag )
4204 UFWORD(PAR_TBRANCH
) {
4212 // (0BRANCH) ( flag )
4213 UFWORD(PAR_0BRANCH
) {
4221 // (+0BRANCH) ( flag )
4222 UFWORD(PAR_P0BRANCH
) {
4223 if ((ufoPop() & 0x80000000u
) == 0) {
4230 // (+BRANCH) ( flag )
4231 UFWORD(PAR_PBRANCH
) {
4232 const int32_t v
= (int32_t)ufoPop();
4240 // (-0BRANCH) ( flag )
4241 UFWORD(PAR_M0BRANCH
) {
4242 const int32_t v
= (int32_t)ufoPop();
4250 // (-BRANCH) ( flag )
4251 UFWORD(PAR_MBRANCH
) {
4252 if ((ufoPop() & 0x80000000u
) != 0) {
4259 // (DATASKIP) ( -- )
4260 UFWORD(PAR_DATASKIP
) {
4261 ufoIP
+= UFO_ALIGN4(4u + ufoImgGetU32(ufoIP
));
4265 // ( !0 -- !0 ) -- jmp
4266 // ( 0 -- ) -- no jmp
4267 UFWORD(PAR_OR_BRANCH
) {
4278 // ( 0 -- 0 ) -- jmp
4279 // ( !0 -- ) -- no jmp
4280 UFWORD(PAR_AND_BRANCH
) {
4292 // ( !0 -- !0 ) -- no jmp
4293 UFWORD(PAR_QDUP_0BRANCH
) {
4305 // ( n !0 -- ) -- no jmp
4306 UFWORD(PAR_CASE_BRANCH
) {
4318 // ////////////////////////////////////////////////////////////////////////// //
4319 // execute words by CFA
4324 UFO_EXEC_CFA(ufoPop());
4327 // EXECUTE-TAIL ( cfa )
4328 UFWORD(EXECUTE_TAIL
) {
4329 if (ufoRP
!= 0) ufoIP
= ufoRPop();
4330 UFO_EXEC_CFA(ufoPop());
4333 // @EXECUTE ( addr )
4334 UFWORD(LOAD_EXECUTE
) {
4335 const uint32_t addr
= ufoPop();
4336 UFO_EXEC_CFA(ufoImgGetU32(addr
));
4339 // @EXECUTE-TAIL ( cfa )
4340 UFWORD(LOAD_EXECUTE_TAIL
) {
4341 if (ufoRP
!= 0) ufoIP
= ufoRPop();
4342 const uint32_t addr
= ufoPop();
4343 UFO_EXEC_CFA(ufoImgGetU32(addr
));
4346 // (FORTH-CALL) ( pfa )
4347 UFWORD(FORTH_CALL
) {
4352 // (FORTH-TAIL-CALL) ( pfa )
4353 UFWORD(FORTH_TAIL_CALL
) {
4358 // ////////////////////////////////////////////////////////////////////////// //
4359 // word termination, locals support
4364 if (ufoRP
== 0) longjmp(ufoStopVMJP
, 667);
4366 ufoIP
= ufoRStack
[ufoRP
];
4367 //ufoIP = ufoRPop();
4371 // ( -- self-value )
4372 UFWORD(PAR_SELF_LOAD
) {
4373 ufoPush(ufoImgGetU32(ufoAddrSelf
));
4377 // ( self-value -- )
4378 UFWORD(PAR_SELF_STORE
) {
4379 const uint32_t val
= ufoPop();
4380 ufoImgPutU32(ufoAddrSelf
, val
);
4385 UFWORD(PAR_LENTER
) {
4386 // low byte of loccount is total number of locals
4387 // high byte is the number of args
4388 uint32_t lcount
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
4389 uint32_t acount
= (lcount
>> 8) & 0xff;
4391 if (lcount
== 0 || lcount
< acount
) ufoFatal("invalid call to (L-ENTER)");
4392 if ((ufoLBP
!= 0 && ufoLBP
>= ufoLP
) || UFO_LSTACK_SIZE
- ufoLP
<= lcount
+ 2) {
4393 ufoFatal("out of locals stack");
4396 if (ufoLP
== 0) { ufoLP
= 1; newbp
= 1; } else newbp
= ufoLP
;
4397 //fprintf(stderr, "LP: %u; LBP: %u; locs: %u; word: %s\n", ufoLP, ufoLBP, fw->locs, fw->name);
4398 ufoLStack
[ufoLP
] = ufoLBP
; ufoLP
+= 1;
4399 ufoLBP
= newbp
; ufoLP
+= lcount
;
4402 while (newbp
!= ufoLBP
) {
4403 ufoLStack
[newbp
] = ufoPop();
4409 UFWORD(PAR_LLEAVE
) {
4410 if (ufoLBP
== 0) ufoFatal("(L-LEAVE) with empty locals stack");
4411 if (ufoLBP
>= ufoLP
) ufoFatal("(L-LEAVE) broken locals stack");
4413 ufoLBP
= ufoLStack
[ufoLBP
];
4416 //==========================================================================
4420 //==========================================================================
4421 UFO_FORCE_INLINE
void ufoLoadLocal (const uint32_t lidx
) {
4422 if (lidx
== 0 || lidx
>= UFO_LSTACK_SIZE
) ufoFatal("invalid local index");
4423 if (ufoLBP
== 0 || ufoLBP
>= ufoLP
|| ufoLP
- ufoLBP
<= lidx
) ufoFatal("invalid local index");
4424 ufoPush(ufoLStack
[ufoLBP
+ lidx
]);
4427 //==========================================================================
4431 //==========================================================================
4432 UFO_FORCE_INLINE
void ufoStoreLocal (const uint32_t lidx
) {
4433 const uint32_t value
= ufoPop();
4434 if (lidx
== 0 || lidx
>= UFO_LSTACK_SIZE
) ufoFatal("invalid local index");
4435 if (ufoLBP
== 0 || ufoLBP
>= ufoLP
|| ufoLP
- ufoLBP
<= lidx
) ufoFatal("invalid local index");
4436 ufoLStack
[ufoLBP
+ lidx
] = value
;
4441 UFWORD(PAR_LOCAL_LOAD
) { ufoLoadLocal(ufoPop()); }
4445 UFWORD(PAR_LOCAL_STORE
) { ufoStoreLocal(ufoPop()); }
4448 // ////////////////////////////////////////////////////////////////////////// //
4449 // stack manipulation
4454 UFWORD(DUP
) { ufoDup(); }
4459 const uint32_t b
= UFO_TOS
;
4466 const uint32_t b
= ufoPop();
4467 const uint32_t a
= ufoPop();
4468 ufoPush(b
); ufoPush(a
); ufoPush(b
);
4471 // ( n -- n n ) | ( 0 -- 0 )
4474 const uint32_t n
= UFO_TOS
;
4478 // ( n0 n1 -- n0 n1 n0 n1 )
4479 UFWORD(DDUP
) { ufo2Dup(); }
4482 UFWORD(DROP
) { ufoDrop(); }
4485 UFWORD(DDROP
) { ufo2Drop(); }
4487 // ( n0 n1 -- n1 n0 )
4488 UFWORD(SWAP
) { ufoSwap(); }
4490 // ( n0 n1 -- n1 n0 )
4491 UFWORD(DSWAP
) { ufo2Swap(); }
4493 // ( n0 n1 -- n0 n1 n0 )
4494 UFWORD(OVER
) { ufoOver(); }
4496 // ( n0 n1 -- n0 n1 n0 )
4497 UFWORD(DOVER
) { ufo2Over(); }
4499 // ( n0 n1 n2 -- n1 n2 n0 )
4500 UFWORD(ROT
) { ufoRot(); }
4502 // ( n0 n1 n2 -- n2 n0 n1 )
4503 UFWORD(NROT
) { ufoNRot(); }
4507 UFWORD(RDUP
) { ufoRDup(); }
4510 UFWORD(RDROP
) { ufoRDrop(); }
4514 UFWORD(DTOR
) { ufoRPush(ufoPop()); }
4517 UFWORD(RTOD
) { ufoPush(ufoRPop()); }
4520 UFWORD(RPEEK
) { ufoPush(ufoRPeek()); }
4528 // ( a b | -- | a b )
4530 const uint32_t b
= ufoPop();
4531 const uint32_t a
= ufoPop();
4536 // ( | a b -- a b | )
4538 const uint32_t b
= ufoRPop();
4539 const uint32_t a
= ufoRPop();
4544 // ( | a b -- a b | a b )
4554 const uint32_t n
= ufoPop();
4555 if (n
>= ufoSP
) ufoFatal("invalid PICK index %u", n
);
4556 ufoPush(ufoDStack
[ufoSP
- n
- 1u]);
4562 const uint32_t n
= ufoPop();
4563 if (n
>= ufoRP
) ufoFatal("invalid RPICK index %u", n
);
4564 const uint32_t rp
= ufoRP
- n
- 1u;
4565 ufoPush(ufoRStack
[rp
]);
4571 const uint32_t n
= ufoPop();
4572 if (n
>= ufoSP
) ufoFatal("invalid ROLL index %u", n
);
4574 case 0: break; // do nothing
4575 case 1: ufoSwap(); break;
4576 case 2: ufoRot(); break;
4579 const uint32_t val
= ufoDStack
[ufoSP
- n
- 1u];
4580 for (uint32_t f
= ufoSP
- n
; f
< ufoSP
; f
+= 1) ufoDStack
[f
- 1] = ufoDStack
[f
];
4581 ufoDStack
[ufoSP
- 1u] = val
;
4590 const uint32_t n
= ufoPop();
4591 if (n
>= ufoRP
) ufoFatal("invalid RROLL index %u", n
);
4593 const uint32_t rp
= ufoRP
- n
- 1u;
4594 const uint32_t val
= ufoRStack
[rp
];
4595 for (uint32_t f
= rp
+ 1u; f
< ufoRP
; f
+= 1u) ufoRStack
[f
- 1u] = ufoRStack
[f
];
4596 ufoRStack
[ufoRP
- 1u] = val
;
4601 // ( | a b -- | b a )
4604 const uint32_t b
= UFO_RTOS
;
4605 const uint32_t a
= UFO_R(1);
4611 // ( | a b -- | a b a )
4614 const uint32_t a
= UFO_R(1);
4619 // ( | a b c -- | b c a )
4622 const uint32_t c
= UFO_RTOS
;
4623 const uint32_t b
= UFO_R(1);
4624 const uint32_t a
= UFO_R(2);
4631 // ( | a b c -- | c a b )
4634 const uint32_t c
= UFO_RTOS
;
4635 const uint32_t b
= UFO_R(1);
4636 const uint32_t a
= UFO_R(2);
4643 // ////////////////////////////////////////////////////////////////////////// //
4650 ufoPushBool(ufoLoadNextLine(1));
4655 UFWORD(REFILL_NOCROSS
) {
4656 ufoPushBool(ufoLoadNextLine(0));
4662 ufoPush(ufoImgGetU32(ufoAddrTIBx
) + ufoImgGetU32(ufoAddrINx
));
4667 UFWORD(TIB_PEEKCH
) {
4668 ufoPush(ufoTibPeekCh());
4673 UFWORD(TIB_PEEKCH_OFS
) {
4674 const uint32_t ofs
= ufoPop();
4675 ufoPush(ufoTibPeekChOfs(ofs
));
4681 ufoPush(ufoTibGetCh());
4686 UFWORD(TIB_SKIPCH
) {
4691 // ////////////////////////////////////////////////////////////////////////// //
4695 //==========================================================================
4699 //==========================================================================
4700 UFO_FORCE_INLINE
int ufoIsDelim (uint8_t ch
, uint8_t delim
) {
4701 return (delim
== 32 ? (ch
<= 32) : (ch
== delim
));
4705 // ( delim skip-leading-delim? -- addr count TRUE / FALSE )
4706 // does base TIB parsing; never copies anything.
4707 // as our reader is line-based, returns FALSE on EOL.
4708 // EOL is detected after skipping leading delimiters.
4709 // passing -1 as delimiter skips the whole line, and always returns FALSE.
4710 // trailing delimiter is always skipped.
4712 const uint32_t skipDelim
= ufoPop();
4713 const uint32_t delim
= ufoPop();
4716 if (delim
== 0 || delim
> 0xffU
) {
4718 while (ufoTibGetCh() != 0) {}
4721 ch
= ufoTibPeekCh();
4722 // skip initial delimiters
4724 while (ch
!= 0 && ufoIsDelim(ch
, delim
)) {
4726 ch
= ufoTibPeekCh();
4733 const uint32_t staddr
= ufoImgGetU32(ufoAddrTIBx
) + ufoImgGetU32(ufoAddrINx
);
4735 while (ch
!= 0 && !ufoIsDelim(ch
, delim
)) {
4738 ch
= ufoTibPeekCh();
4741 if (ch
!= 0) ufoTibSkipCh();
4749 // PARSE-SKIP-BLANKS
4751 UFWORD(PARSE_SKIP_BLANKS
) {
4752 uint8_t ch
= ufoTibPeekCh();
4753 while (ch
!= 0 && ch
<= 32) {
4755 ch
= ufoTibPeekCh();
4759 //==========================================================================
4761 // ufoParseMLComment
4763 // initial two chars are skipped
4765 //==========================================================================
4766 static void ufoParseMLComment (uint32_t allowMulti
, int nested
) {
4769 while (level
!= 0) {
4773 UFCALL(REFILL_NOCROSS
);
4774 if (ufoPop() == 0) ufoFatal("unexpected end of file in comment");
4776 ufoFatal("unexpected end of line in comment");
4779 ch1
= ufoTibPeekCh();
4780 if (nested
&& ch
== '(' && ch1
== '(') { ufoTibSkipCh(); level
+= 1; }
4781 else if (nested
&& ch
== ')' && ch1
== ')') { ufoTibSkipCh(); level
-= 1; }
4782 else if (!nested
&& ch
== '*' && ch1
== ')') { ufo_assert(level
== 1); ufoTibSkipCh(); level
= 0; }
4787 // (PARSE-SKIP-COMMENTS)
4788 // ( allow-multiline? -- )
4789 // skip all blanks and comments
4790 UFWORD(PAR_PARSE_SKIP_COMMENTS
) {
4791 const uint32_t allowMulti
= ufoPop();
4793 ch
= ufoTibPeekCh();
4795 fprintf(stderr
, "(PARSE-SKIP-COMMENTS): first-ch:'%c'\n", (char)ch
);
4800 ch
= ufoTibPeekCh();
4802 fprintf(stderr
, "(PARSE-SKIP-COMMENTS): blank-ch:'%c'\n", (char)ch
);
4804 } else if (ch
== '(') {
4806 fprintf(stderr
, "(PARSE-SKIP-COMMENTS): ch:'%c'; ch1:'%c' ('%c')\n", (char)ch
, (char)ch1
,
4807 ufoTibPeekChOfs(0));
4809 ch1
= ufoTibPeekChOfs(1);
4811 // single-line comment
4812 do { ch
= ufoTibGetCh(); } while (ch
!= 0 && ch
!= ')');
4813 ch
= ufoTibPeekCh();
4814 } else if ((ch1
== '*' || ch1
== '(') && ufoTibPeekChOfs(2) <= 32) {
4815 // possibly multiline
4816 ufoTibSkipCh(); ufoTibSkipCh(); // skip opening
4817 ufoParseMLComment(allowMulti
, (ch1
== '('));
4818 ch
= ufoTibPeekCh();
4822 } else if (ch
== '\\' && ufoTibPeekChOfs(1) <= 32) {
4823 // single-line comment
4824 while (ch
!= 0) ch
= ufoTibGetCh();
4825 } else if (ch
== '-' && ufoTibPeekChOfs(1) == ch
&& ufoTibPeekChOfs(2) <= 32) {
4827 while (ch
!= 0) ch
= ufoTibGetCh();
4828 } else if ((ch
== ';' || ch
== '/') && ufoTibPeekChOfs(1) == ch
) {
4830 while (ch
!= 0) ch
= ufoTibGetCh();
4836 fprintf(stderr
, "(PARSE-SKIP-COMMENTS): end-ch:'%c'\n", ufoTibPeekCh());
4842 UFWORD(PARSE_SKIP_LINE
) {
4843 ufoPush(0); ufoPushBool(0); UFCALL(PAR_PARSE
);
4844 if (ufoPop() != 0) {
4850 // ( -- addr count )
4851 // parse with leading blanks skipping. doesn't copy anything.
4852 // return empty string on EOL.
4853 UFWORD(PARSE_NAME
) {
4854 ufoPush(32); ufoPushBool(1); UFCALL(PAR_PARSE
);
4855 if (ufoPop() == 0) {
4862 // ( delim -- addr count TRUE / FALSE )
4863 // parse without skipping delimiters; never copies anything.
4864 // as our reader is line-based, returns FALSE on EOL.
4865 // passing 0 as delimiter skips the whole line, and always returns FALSE.
4866 // trailing delimiter is always skipped.
4868 ufoPushBool(0); UFCALL(PAR_PARSE
);
4872 // ////////////////////////////////////////////////////////////////////////// //
4878 UFWORD(PAR_NORM_EMIT_CHAR
) {
4879 uint32_t ch
= ufoPop()&0xffU
;
4880 if (ch
< 32 || ch
== 127) {
4881 if (ch
!= 9 && ch
!= 10 && ch
!= 13) ch
= '?';
4886 // (NORM-XEMIT-CHAR)
4888 UFWORD(PAR_NORM_XEMIT_CHAR
) {
4889 uint32_t ch
= ufoPop()&0xffU
;
4890 if (ch
< 32 || ch
== 127) ch
= '?';
4897 uint32_t ch
= ufoPop()&0xffU
;
4898 ufoLastEmitWasCR
= (ch
== 10);
4905 ufoPushBool(ufoLastEmitWasCR
);
4911 ufoLastEmitWasCR
= !!ufoPop();
4916 UFWORD(FLUSH_EMIT
) {
4921 // ////////////////////////////////////////////////////////////////////////// //
4925 #define UF_BMATH(name_,op_) \
4928 const uint32_t b = UFO_TOS; \
4929 const uint32_t a = UFO_S(1); \
4934 #define UF_BDIV(name_,op_) \
4937 const uint32_t b = UFO_TOS; \
4938 const uint32_t a = UFO_S(1); \
4939 if (b == 0) ufoFatal("division by zero"); \
4944 #define UFO_POP_U64() ({ \
4946 const uint32_t hi_ = UFO_TOS; \
4947 const uint32_t lo_ = UFO_S(1); \
4949 (((uint64_t)hi_ << 32) | lo_); \
4952 // this is UB by the idiotic C standard. i don't care.
4953 #define UFO_POP_I64() ((int64_t)UFO_POP_U64())
4955 #define UFO_PUSH_U64(vn_) do { \
4956 ufoPush((uint32_t)(vn_)); \
4957 ufoPush((uint32_t)((vn_) >> 32)); \
4960 // this is UB by the idiotic C standard. i don't care.
4961 #define UFO_PUSH_I64(vn_) UFO_PUSH_U64((uint64_t)(vn_))
4965 UF_BMATH(PLUS
, a
+ b
);
4969 UF_BMATH(MINUS
, a
- b
);
4973 UF_BMATH(MUL
, (uint32_t)((int32_t)a
* (int32_t)b
));
4977 UF_BMATH(UMUL
, a
* b
);
4981 UF_BDIV(DIV
, (uint32_t)((int32_t)a
/ (int32_t)b
));
4985 UF_BDIV(UDIV
, a
/ b
);
4989 UF_BDIV(MOD
, (uint32_t)((int32_t)a
% (int32_t)b
));
4993 UF_BDIV(UMOD
, a
% b
);
4996 // ( a b -- a/b, a%b )
4998 const int32_t b
= (int32_t)ufoPop();
4999 const int32_t a
= (int32_t)ufoPop();
5000 if (b
== 0) ufoFatal("division by zero");
5001 ufoPush((uint32_t)(a
/b
));
5002 ufoPush((uint32_t)(a
%b
));
5006 // ( a b -- a/b, a%b )
5008 const uint32_t b
= ufoPop();
5009 const uint32_t a
= ufoPop();
5010 if (b
== 0) ufoFatal("division by zero");
5011 ufoPush((uint32_t)(a
/b
));
5012 ufoPush((uint32_t)(a
%b
));
5016 // ( a b c -- a*b/c )
5017 // this uses 64-bit intermediate value
5019 const int32_t c
= (int32_t)ufoPop();
5020 const int32_t b
= (int32_t)ufoPop();
5021 const int32_t a
= (int32_t)ufoPop();
5022 if (c
== 0) ufoFatal("division by zero");
5023 int64_t xval
= a
; xval
*= b
; xval
/= c
;
5024 ufoPush((uint32_t)(int32_t)xval
);
5028 // ( a b c -- a*b/c )
5029 // this uses 64-bit intermediate value
5031 const uint32_t c
= ufoPop();
5032 const uint32_t b
= ufoPop();
5033 const uint32_t a
= ufoPop();
5034 if (c
== 0) ufoFatal("division by zero");
5035 uint64_t xval
= a
; xval
*= b
; xval
/= c
;
5036 ufoPush((uint32_t)xval
);
5040 // ( a b c -- a*b/c a*b%c )
5041 // this uses 64-bit intermediate value
5043 const int32_t c
= (int32_t)ufoPop();
5044 const int32_t b
= (int32_t)ufoPop();
5045 const int32_t a
= (int32_t)ufoPop();
5046 if (c
== 0) ufoFatal("division by zero");
5047 int64_t xval
= a
; xval
*= b
;
5048 ufoPush((uint32_t)(int32_t)(xval
/ c
));
5049 ufoPush((uint32_t)(int32_t)(xval
% c
));
5053 // ( a b c -- a*b/c )
5054 // this uses 64-bit intermediate value
5055 UFWORD(UMULDIVMOD
) {
5056 const uint32_t c
= ufoPop();
5057 const uint32_t b
= ufoPop();
5058 const uint32_t a
= ufoPop();
5059 if (c
== 0) ufoFatal("division by zero");
5060 uint64_t xval
= a
; xval
*= b
;
5061 ufoPush((uint32_t)(xval
/ c
));
5062 ufoPush((uint32_t)(xval
% c
));
5066 // ( a b -- lo(a*b) hi(a*b) )
5067 // this leaves 64-bit result
5069 const int32_t b
= (int32_t)ufoPop();
5070 const int32_t a
= (int32_t)ufoPop();
5071 int64_t xval
= a
; xval
*= b
;
5076 // ( a b -- lo(a*b) hi(a*b) )
5077 // this leaves 64-bit result
5079 const uint32_t b
= ufoPop();
5080 const uint32_t a
= ufoPop();
5081 uint64_t xval
= a
; xval
*= b
;
5086 // ( alo ahi b -- a/b a%b )
5088 const int32_t b
= (int32_t)ufoPop();
5089 if (b
== 0) ufoFatal("division by zero");
5090 int64_t a
= UFO_POP_I64();
5091 int32_t adiv
= (int32_t)(a
/ b
);
5092 int32_t amod
= (int32_t)(a
% b
);
5093 ufoPush((uint32_t)adiv
);
5094 ufoPush((uint32_t)amod
);
5098 // ( alo ahi b -- a/b a%b )
5100 const uint32_t b
= ufoPop();
5101 if (b
== 0) ufoFatal("division by zero");
5102 uint64_t a
= UFO_POP_U64();
5103 uint32_t adiv
= (uint32_t)(a
/ b
);
5104 uint32_t amod
= (uint32_t)(a
% b
);
5110 // ( alo ahi u -- lo hi )
5112 const uint32_t b
= ufoPop();
5113 uint64_t a
= UFO_POP_U64();
5119 // ( lo0 hi0 lo1 hi1 -- lo hi )
5121 uint64_t n1
= UFO_POP_U64();
5122 uint64_t n0
= UFO_POP_U64();
5128 // ( lo0 hi0 lo1 hi1 -- lo hi )
5130 uint64_t n1
= UFO_POP_U64();
5131 uint64_t n0
= UFO_POP_U64();
5137 // ( lo0 hi0 lo1 hi1 -- bool )
5139 uint64_t n1
= UFO_POP_U64();
5140 uint64_t n0
= UFO_POP_U64();
5141 ufoPushBool(n0
== n1
);
5145 // ( lo0 hi0 lo1 hi1 -- bool )
5147 int64_t n1
= UFO_POP_I64();
5148 int64_t n0
= UFO_POP_I64();
5149 ufoPushBool(n0
< n1
);
5153 // ( lo0 hi0 lo1 hi1 -- bool )
5155 int64_t n1
= UFO_POP_I64();
5156 int64_t n0
= UFO_POP_I64();
5157 ufoPushBool(n0
<= n1
);
5161 // ( lo0 hi0 lo1 hi1 -- bool )
5163 uint64_t n1
= UFO_POP_U64();
5164 uint64_t n0
= UFO_POP_U64();
5165 ufoPushBool(n0
< n1
);
5169 // ( lo0 hi0 lo1 hi1 -- bool )
5171 uint64_t n1
= UFO_POP_U64();
5172 uint64_t n0
= UFO_POP_U64();
5173 ufoPushBool(n0
<= n1
);
5177 // ( dlo dhi n -- nmod ndiv )
5178 // rounds toward zero
5180 const int32_t n
= (int32_t)ufoPop();
5181 if (n
== 0) ufoFatal("division by zero");
5182 int64_t d
= UFO_POP_I64();
5183 int32_t ndiv
= (int32_t)(d
/ n
);
5184 int32_t nmod
= (int32_t)(d
% n
);
5190 // ( dlo dhi n -- nmod ndiv )
5191 // rounds toward negative infinity
5193 const int32_t n
= (int32_t)ufoPop();
5194 if (n
== 0) ufoFatal("division by zero");
5195 int64_t d
= UFO_POP_I64();
5196 int32_t ndiv
= (int32_t)(d
/ n
);
5197 int32_t nmod
= (int32_t)(d
% n
);
5198 if (nmod
!= 0 && ((uint32_t)n
^ (uint32_t)(d
>> 32)) >= 0x80000000u
) {
5207 // ////////////////////////////////////////////////////////////////////////// //
5208 // simple logic and bit manipulation
5211 #define UF_CMP(name_,op_) \
5213 const uint32_t b = ufoPop(); \
5214 const uint32_t a = ufoPop(); \
5220 UF_CMP(LESS
, (int32_t)a
< (int32_t)b
);
5224 UF_CMP(ULESS
, a
< b
);
5228 UF_CMP(GREAT
, (int32_t)a
> (int32_t)b
);
5232 UF_CMP(UGREAT
, a
> b
);
5236 UF_CMP(LESSEQU
, (int32_t)a
<= (int32_t)b
);
5240 UF_CMP(ULESSEQU
, a
<= b
);
5244 UF_CMP(GREATEQU
, (int32_t)a
>= (int32_t)b
);
5248 UF_CMP(UGREATEQU
, a
>= b
);
5252 UF_CMP(EQU
, a
== b
);
5256 UF_CMP(NOTEQU
, a
!= b
);
5261 const uint32_t a
= ufoPop();
5262 ufoPushBool(a
== 0);
5267 UFWORD(ZERO_NOTEQU
) {
5268 const uint32_t a
= ufoPop();
5269 ufoPushBool(a
!= 0);
5274 UF_CMP(LOGAND
, a
&& b
);
5278 UF_CMP(LOGOR
, a
|| b
);
5283 const uint32_t b
= ufoPop();
5284 const uint32_t a
= ufoPop();
5291 const uint32_t b
= ufoPop();
5292 const uint32_t a
= ufoPop();
5299 const uint32_t b
= ufoPop();
5300 const uint32_t a
= ufoPop();
5308 UFO_TOS
&= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
5315 UFO_TOS
&= ~ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
5322 UFO_TOS
|= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
5329 UFO_TOS
^= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
5336 const uint32_t a
= ufoPop();
5342 // arithmetic shift; positive `n` shifts to the left
5344 int32_t c
= (int32_t)ufoPop();
5347 int32_t n
= (int32_t)ufoPop();
5349 n
>>= (uint8_t)(-c
);
5351 if (n
< 0) n
= -1; else n
= 0;
5353 ufoPush((uint32_t)n
);
5356 uint32_t u
= ufoPop();
5368 // logical shift; positive `n` shifts to the left
5370 int32_t c
= (int32_t) ufoPop();
5371 uint32_t u
= ufoPop();
5375 u
>>= (uint8_t)(-c
);
5392 // arithmetic shift right
5394 int32_t c
= (int32_t)ufoPop();
5396 int32_t n
= (int32_t)ufoPop();
5400 if (n
< 0) n
= -1; else n
= 0;
5402 ufoPush((uint32_t)n
);
5404 ufoFatal("negative shift");
5410 // logical shift right
5412 uint32_t c
= (int32_t)ufoPop();
5414 uint32_t n
= (int32_t)ufoPop();
5420 ufoPush((uint32_t)n
);
5422 ufoFatal("negative shift");
5428 // logical shift left
5430 int32_t c
= (int32_t) ufoPop();
5431 uint32_t u
= ufoPop();
5440 ufoFatal("negative shift");
5447 const uint32_t b
= ufoPop();
5448 const uint32_t a
= ufoPop();
5455 if ((ufoPeek() & 0x80000000) != 0) {
5456 UFO_TOS
= ~UFO_TOS
+ 1u;
5464 UFO_TOS
= ~UFO_TOS
+ 1u;
5470 const uint32_t a
= ufoPop();
5471 if ((a
& 0x80000000) != 0) ufoPush(~(uint32_t)0);
5472 else if (a
!= 0) ufoPush(1);
5477 // ( a -- a&0xffff )
5491 // ( a -- (a>>16)&0xffff )
5494 UFO_TOS
= (UFO_TOS
>>16)&0xffffU
;
5498 // ( a -- (a>>8)&0xff )
5501 UFO_TOS
= (UFO_TOS
>>8)&0xffU
;
5505 // ( a b -- min[a,b] )
5507 const int32_t b
= (int32_t)ufoPop();
5509 if ((int32_t)UFO_TOS
> b
) UFO_TOS
= (uint32_t)b
;
5513 // ( a b -- max[a,b] )
5515 const int32_t b
= (int32_t)ufoPop();
5517 if ((int32_t)UFO_TOS
< b
) UFO_TOS
= (uint32_t)b
;
5521 // ( a b -- umin[a,b] )
5523 const uint32_t b
= ufoPop();
5525 if (UFO_TOS
> b
) UFO_TOS
= b
;
5529 // ( a b -- umax[a,b] )
5531 const uint32_t b
= ufoPop();
5533 if (UFO_TOS
< b
) UFO_TOS
= b
;
5537 // ( a lo hi -- a>=lo&&a<hi )
5539 //const int32_t hi = (int32_t)ufoPop();
5540 //const int32_t lo = (int32_t)ufoPop();
5541 //const int32_t a = (int32_t)ufoPop();
5542 //ufoPushBool(a >= lo && a < hi);
5543 // sadly, idiotic ANS standard requires this:
5544 const uint32_t hi
= ufoPop();
5545 const uint32_t lo
= ufoPop();
5546 const uint32_t a
= ufoPop();
5547 ufoPushBool(a
- lo
< hi
- lo
);
5551 // ( ua ulo uhi -- ua>=ulo&&ua<uhi )
5553 const uint32_t hi
= ufoPop();
5554 const uint32_t lo
= ufoPop();
5555 const uint32_t a
= ufoPop();
5556 ufoPushBool(a
>= lo
&& a
< hi
);
5560 // ( ua ulo uhi -- ua>=ulo&&ua<=uhi )
5562 const uint32_t hi
= ufoPop();
5563 const uint32_t lo
= ufoPop();
5564 const uint32_t a
= ufoPop();
5565 ufoPushBool(a
>= lo
&& a
<= hi
);
5572 const uint32_t a
= UFO_TOS
;
5573 UFO_TOS
= (uint32_t)__builtin_bswap16((uint16_t)a
);
5580 const uint32_t a
= UFO_TOS
;
5581 UFO_TOS
= __builtin_bswap32(a
);
5586 UFWORD(PAR_SWAP_INC_SWAP
) {
5650 const uint32_t n
= ufoPop();
5658 const uint32_t n
= ufoPop();
5688 UFO_TOS
= (uint32_t)((int32_t)UFO_TOS
>> 1);
5695 UFO_TOS
= (uint32_t)((int32_t)UFO_TOS
>> 2);
5702 UFO_TOS
= (uint32_t)((int32_t)UFO_TOS
>> 3);
5730 if ((int32_t)UFO_TOS
< 0) UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
5737 if ((int32_t)UFO_TOS
<= 0) UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
5744 if ((int32_t)UFO_TOS
> 0) UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
5751 if ((int32_t)UFO_TOS
>= 0) UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
5755 // ////////////////////////////////////////////////////////////////////////// //
5756 // string unescaping
5760 // ( addr count -- addr count )
5761 UFWORD(PAR_UNESCAPE
) {
5762 const uint32_t count
= ufoPop();
5763 const uint32_t addr
= ufoPeek();
5764 if ((count
& ((uint32_t)1<<31)) == 0) {
5765 const uint32_t eaddr
= addr
+ count
;
5766 uint32_t caddr
= addr
;
5767 uint32_t daddr
= addr
;
5768 while (caddr
!= eaddr
) {
5769 uint8_t ch
= ufoImgGetU8(caddr
); caddr
+= 1u;
5770 if (ch
== '\\' && caddr
!= eaddr
) {
5771 ch
= ufoImgGetU8(caddr
); caddr
+= 1u;
5773 case 'r': ch
= '\r'; break;
5774 case 'n': ch
= '\n'; break;
5775 case 't': ch
= '\t'; break;
5776 case 'e': ch
= '\x1b'; break;
5777 case '`': ch
= '"'; break; // special escape to insert double-quote
5778 case '"': ch
= '"'; break;
5779 case '\\': ch
= '\\'; break;
5781 if (eaddr
- daddr
>= 1) {
5782 const int dg0
= digitInBase((char)(ufoImgGetU8(caddr
)), 16);
5783 if (dg0
< 0) ufoFatal("invalid hex string escape");
5784 if (eaddr
- daddr
>= 2) {
5785 const int dg1
= digitInBase((char)(ufoImgGetU8(caddr
+ 1u)), 16);
5786 if (dg1
< 0) ufoFatal("invalid hex string escape");
5787 ch
= (uint8_t)(dg0
* 16 + dg1
);
5794 ufoFatal("invalid hex string escape");
5797 default: ufoFatal("invalid string escape");
5800 ufoImgPutU8(daddr
, ch
); daddr
+= 1u;
5802 ufoPush(daddr
- addr
);
5809 // ////////////////////////////////////////////////////////////////////////// //
5810 // numeric conversions
5813 // (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
5814 UFWORD(PAR_BASED_NUMBER
) {
5815 const uint32_t xbase
= ufoPop();
5816 const uint32_t allowSign
= ufoPop();
5817 int32_t count
= (int32_t)ufoPop();
5818 uint32_t addr
= ufoPop();
5824 if (allowSign
&& count
> 1) {
5825 ch
= ufoImgGetU8(addr
);
5826 if (ch
== '-') { neg
= 1; addr
+= 1u; count
-= 1; }
5827 else if (ch
== '+') { neg
= 0; addr
+= 1u; count
-= 1; }
5830 // special-based numbers
5831 ch
= ufoImgGetU8(addr
);
5832 if (count
>= 3 && ch
== '0') {
5833 switch (ufoImgGetU8(addr
+ 1u)) {
5834 case 'x': case 'X': base
= 16; break;
5835 case 'o': case 'O': base
= 8; break;
5836 case 'b': case 'B': base
= 2; break;
5837 case 'd': case 'D': base
= 10; break;
5840 if (base
&& digitInBase((char)ufoImgGetU8(addr
+ (uint32_t)count
- 1u), base
) >= 0) {
5841 addr
+= 2; count
-= 2;
5845 } else if (count
>= 2 && ch
== '$') {
5847 addr
+= 1u; count
-= 1;
5848 } else if (count
>= 2 && ch
== '#') {
5850 addr
+= 1u; count
-= 1;
5851 } else if (count
>= 2 && ch
== '%') {
5853 addr
+= 1u; count
-= 1;
5854 } else if (count
>= 3 && ch
== '&') {
5855 switch (ufoImgGetU8(addr
+ 1u)) {
5856 case 'h': case 'H': base
= 16; break;
5857 case 'o': case 'O': base
= 8; break;
5858 case 'b': case 'B': base
= 2; break;
5859 case 'd': case 'D': base
= 10; break;
5862 if (base
) { addr
+= 2u; count
-= 2; }
5864 if (!base
&& count
> 2 && ch
>= '0' && ch
<= '9') {
5865 ch
= ufoImgGetU8(addr
+ (uint32_t)count
- 1u);
5867 case 'b': case 'B': if (xbase
< 12) base
= 2; break;
5868 case 'o': case 'O': if (xbase
< 25) base
= 8; break;
5869 case 'h': case 'H': if (xbase
< 18) base
= 16; break;
5871 if (base
) count
-= 1;
5875 if (!base
&& xbase
< 255) base
= xbase
;
5877 if (count
<= 0 || base
< 1 || base
> 36) {
5881 int wasDig
= 0, wasUnder
= 1, error
= 0, dig
;
5882 while (!error
&& count
!= 0) {
5883 ch
= ufoImgGetU8(addr
); addr
+= 1u; count
-= 1;
5885 error
= 1; wasUnder
= 0; wasDig
= 1;
5886 dig
= digitInBase((char)ch
, (int)base
);
5888 nc
= n
* (uint32_t)base
;
5890 nc
+= (uint32_t)dig
;
5903 if (!error
&& wasDig
&& !wasUnder
) {
5904 if (allowSign
&& neg
) n
= ~n
+ 1u;
5914 // ////////////////////////////////////////////////////////////////////////// //
5915 // compiler-related, dictionary-related
5918 static char ufoWNameBuf
[256];
5920 // (CREATE-WORD-HEADER)
5921 // ( addr count word-flags -- )
5922 UFWORD(PAR_CREATE_WORD_HEADER
) {
5923 const uint32_t flags
= ufoPop();
5924 const uint32_t wlen
= ufoPop();
5925 const uint32_t waddr
= ufoPop();
5926 if (wlen
== 0) ufoFatal("word name expected");
5927 if (wlen
>= UFO_MAX_WORD_LENGTH
) ufoFatal("word name too long");
5928 // copy to separate buffer
5929 for (uint32_t f
= 0; f
< wlen
; f
+= 1) {
5930 ufoWNameBuf
[f
] = (char)ufoImgGetU8(waddr
+ f
);
5932 ufoWNameBuf
[wlen
] = 0;
5933 ufoCreateWordHeader(ufoWNameBuf
, flags
);
5936 // (CREATE-NAMELESS-WORD-HEADER)
5937 // ( word-flags -- )
5938 UFWORD(PAR_CREATE_NAMELESS_WORD_HEADER
) {
5939 const uint32_t flags
= ufoPop();
5940 ufoCreateWordHeader("", flags
);
5944 // ( addr count -- cfa TRUE / FALSE )
5946 const uint32_t wlen
= ufoPop();
5947 const uint32_t waddr
= ufoPop();
5948 if (wlen
> 0 && wlen
< UFO_MAX_WORD_LENGTH
) {
5949 // copy to separate buffer
5950 for (uint32_t f
= 0; f
< wlen
; f
+= 1) {
5951 ufoWNameBuf
[f
] = (char)ufoImgGetU8(waddr
+ f
);
5953 ufoWNameBuf
[wlen
] = 0;
5954 const uint32_t cfa
= ufoFindWord(ufoWNameBuf
);
5966 // (FIND-WORD-IN-VOC)
5967 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
5968 // find only in the given voc; no name resolution
5969 UFWORD(PAR_FIND_WORD_IN_VOC
) {
5970 const uint32_t allowHidden
= ufoPop();
5971 const uint32_t vocid
= ufoPop();
5972 const uint32_t wlen
= ufoPop();
5973 const uint32_t waddr
= ufoPop();
5974 if (wlen
> 0 && wlen
< UFO_MAX_WORD_LENGTH
) {
5975 // copy to separate buffer
5976 for (uint32_t f
= 0; f
< wlen
; f
+= 1) {
5977 ufoWNameBuf
[f
] = (char)ufoImgGetU8(waddr
+ f
);
5979 ufoWNameBuf
[wlen
] = 0;
5980 const uint32_t cfa
= ufoFindWordInVoc(ufoWNameBuf
, wlen
, 0, vocid
, (allowHidden
? 1 : 0));
5992 // (FIND-WORD-IN-VOC-AND-PARENTS)
5993 // ( addr count vocid allowhidden -- cfa TRUE / FALSE)
5994 // find only in the given voc; no name resolution
5995 UFWORD(PAR_FIND_WORD_IN_VOC_AND_PARENTS
) {
5996 const uint32_t allowHidden
= ufoPop();
5997 const uint32_t vocid
= ufoPop();
5998 const uint32_t wlen
= ufoPop();
5999 const uint32_t waddr
= ufoPop();
6000 if (wlen
> 0 && wlen
< UFO_MAX_WORD_LENGTH
) {
6001 // copy to separate buffer
6002 for (uint32_t f
= 0; f
< wlen
; f
+= 1) {
6003 ufoWNameBuf
[f
] = (char)ufoImgGetU8(waddr
+ f
);
6005 ufoWNameBuf
[wlen
] = 0;
6006 const uint32_t cfa
= ufoFindWordInVocAndParents(ufoWNameBuf
, wlen
, 0, vocid
, (allowHidden
? 1 : 0));
6019 // ( addr count vocid -- cfa TRUE / FALSE)
6020 // find only in the given voc; no name resolution, no hidden words
6021 UFWORD(FIND_WORD_IN_VOC
) { ufoPush(0); UFCALL(PAR_FIND_WORD_IN_VOC
); }
6023 // FIND-WORD-IN-VOC-AND-PARENTS
6024 // ( addr count vocid -- cfa TRUE / FALSE)
6025 // find only in the given voc; no name resolution, no hidden words
6026 UFWORD(FIND_WORD_IN_VOC_AND_PARENTS
) { ufoPush(0); UFCALL(PAR_FIND_WORD_IN_VOC_AND_PARENTS
); }
6029 // ////////////////////////////////////////////////////////////////////////// //
6030 // more compiler words
6033 // ////////////////////////////////////////////////////////////////////////// //
6034 // vocabulary and wordlist utilities
6039 UFWORD(PAR_GET_VSP
) {
6045 UFWORD(PAR_SET_VSP
) {
6046 const uint32_t vsp
= ufoPop();
6047 if (vsp
> UFO_VOCSTACK_SIZE
) ufoFatal("VSP %u out of range (%u)", vsp
, UFO_VOCSTACK_SIZE
);
6053 UFWORD(PAR_VSP_LOAD
) {
6054 const uint32_t vsp
= ufoPop();
6055 if (vsp
>= UFO_VOCSTACK_SIZE
) ufoFatal("VSP %u out of range (%u)", vsp
, UFO_VOCSTACK_SIZE
);
6056 ufoPush(ufoVocStack
[vsp
]);
6061 UFWORD(PAR_VSP_STORE
) {
6062 const uint32_t vsp
= ufoPop();
6063 const uint32_t value
= ufoPop();
6064 if (vsp
>= UFO_VOCSTACK_SIZE
) ufoFatal("VSP %u out of range (%u)", vsp
, UFO_VOCSTACK_SIZE
);
6065 ufoVocStack
[vsp
] = value
;
6069 // ////////////////////////////////////////////////////////////////////////// //
6070 // word field address conversion
6074 // ( cfa -- does-cfa )
6075 UFWORD(CFA2DOESCFA
) {
6077 UFO_TOS
= UFO_CFA_TO_DOES_CFA(UFO_TOS
);
6084 UFO_TOS
= UFO_CFA_TO_PFA(UFO_TOS
);
6091 UFO_TOS
= UFO_CFA_TO_NFA(UFO_TOS
);
6098 UFO_TOS
= UFO_CFA_TO_LFA(UFO_TOS
);
6102 // ( cfa -- wend-addr )
6105 UFO_TOS
= ufoGetWordEndAddr(UFO_TOS
);
6112 UFO_TOS
= UFO_PFA_TO_CFA(UFO_TOS
);
6119 UFO_TOS
= UFO_PFA_TO_CFA(UFO_TOS
);
6120 UFO_TOS
= UFO_CFA_TO_NFA(UFO_TOS
);
6127 UFO_TOS
= UFO_NFA_TO_CFA(UFO_TOS
);
6134 UFO_TOS
= UFO_NFA_TO_CFA(UFO_TOS
);
6135 UFO_TOS
= UFO_CFA_TO_PFA(UFO_TOS
);
6142 UFO_TOS
= UFO_NFA_TO_LFA(UFO_TOS
);
6149 UFO_TOS
= UFO_LFA_TO_CFA(UFO_TOS
);
6156 UFO_TOS
= UFO_LFA_TO_CFA(UFO_TOS
);
6157 UFO_TOS
= UFO_CFA_TO_PFA(UFO_TOS
);
6164 UFO_TOS
= UFO_LFA_TO_BFA(UFO_TOS
);
6171 UFO_TOS
= UFO_LFA_TO_XFA(UFO_TOS
);
6178 UFO_TOS
= UFO_LFA_TO_YFA(UFO_TOS
);
6185 UFO_TOS
= UFO_LFA_TO_NFA(UFO_TOS
);
6189 // ( ip -- nfa / 0 )
6192 UFO_TOS
= ufoFindWordForIP(UFO_TOS
);
6196 // ( ip -- addr count line TRUE / FALSE )
6197 // name is at PAD; it is safe to use PAD, because each task has its own temp image
6198 UFWORD(IP2FILELINE
) {
6199 const uint32_t ip
= ufoPop();
6201 const char *fname
= ufoFindFileForIP(ip
, &fline
, NULL
, NULL
);
6202 if (fname
!= NULL
) {
6203 uint32_t addr
= UFO_PAD_ADDR
;
6205 while (*fname
!= 0) {
6206 ufoImgPutU8(addr
, *(const unsigned char *)fname
);
6207 fname
+= 1u; addr
+= 1u; count
+= 1u;
6209 ufoImgPutU8(addr
, 0); // just in case
6219 // IP->FILE-HASH/LINE
6220 // ( ip -- len hash line TRUE / FALSE )
6221 UFWORD(IP2FILEHASHLINE
) {
6222 const uint32_t ip
= ufoPop();
6223 uint32_t fline
, fhash
, flen
;
6224 const char *fname
= ufoFindFileForIP(ip
, &fline
, &flen
, &fhash
);
6225 if (fname
!= NULL
) {
6236 // ////////////////////////////////////////////////////////////////////////// //
6237 // string operations
6240 UFO_FORCE_INLINE
uint32_t ufoHashBuf (uint32_t addr
, uint32_t size
, uint8_t orbyte
) {
6241 uint32_t hash
= 0x29a;
6242 if ((size
& ((uint32_t)1<<31)) == 0) {
6244 hash
+= ufoImgGetU8(addr
) | orbyte
;
6247 addr
+= 1u; size
-= 1u;
6257 //==========================================================================
6261 //==========================================================================
6262 UFO_FORCE_INLINE
int ufoBufEqu (uint32_t addr0
, uint32_t addr1
, uint32_t count
) {
6264 if ((count
& ((uint32_t)1<<31)) == 0) {
6266 while (res
!= 0 && count
!= 0) {
6267 res
= (toUpperU8(ufoImgGetU8(addr0
)) == toUpperU8(ufoImgGetU8(addr1
)));
6268 addr0
+= 1u; addr1
+= 1u; count
-= 1u;
6277 // ( a0 c0 a1 c1 -- bool )
6279 int32_t c1
= (int32_t)ufoPop();
6280 uint32_t a1
= ufoPop();
6281 int32_t c0
= (int32_t)ufoPop();
6282 uint32_t a0
= ufoPop();
6287 while (res
!= 0 && c0
!= 0) {
6288 res
= (ufoImgGetU8(a0
) == ufoImgGetU8(a1
));
6289 a0
+= 1; a1
+= 1; c0
-= 1;
6298 // ( a0 c0 a1 c1 -- bool )
6300 int32_t c1
= (int32_t)ufoPop();
6301 uint32_t a1
= ufoPop();
6302 int32_t c0
= (int32_t)ufoPop();
6303 uint32_t a0
= ufoPop();
6308 while (res
!= 0 && c0
!= 0) {
6309 res
= (toUpperU8(ufoImgGetU8(a0
)) == toUpperU8(ufoImgGetU8(a1
)));
6310 a0
+= 1; a1
+= 1; c0
-= 1;
6318 // search the string specified by c-addr1 u1 for the string specified by c-addr2 u2.
6319 // if flag is true, a match was found at c-addr3 with u3 characters remaining.
6320 // if flag is false there was no match and c-addr3 is c-addr1 and u3 is u1.
6321 // ( c-addr1 u1 c-addr2 u2 -- c-addr3 u3 flag )
6323 const uint32_t pcount
= ufoPop();
6324 const uint32_t paddr
= ufoPop();
6325 const uint32_t tcount
= ufoPop();
6326 const uint32_t taddr
= ufoPop();
6327 if ((pcount
& ((uint32_t)1 << 31)) == 0 && (tcount
& ((uint32_t)1 << 31)) == 0) {
6328 for (uint32_t f
= 0; tcount
- f
>= pcount
; f
+= 1) {
6329 if (ufoBufEqu(taddr
+ f
, paddr
, pcount
)) {
6331 ufoPush(tcount
- f
);
6343 // ( addr count -- hash )
6345 uint32_t count
= ufoPop();
6346 uint32_t addr
= ufoPop();
6347 ufoPush(ufoHashBuf(addr
, count
, 0));
6351 // ( addr count -- hash )
6353 uint32_t count
= ufoPop();
6354 uint32_t addr
= ufoPop();
6355 ufoPush(ufoHashBuf(addr
, count
, 0x20));
6358 // STRING:CHAR-UPPER
6360 UFWORD(CHAR_UPPER
) {
6362 uint32_t c
= UFO_TOS
& 0xffU
;
6363 if (c
>= 'a' && c
<= 'z') c
= c
- 'a' + 'A';
6367 // STRING:CHAR-LOWER
6369 UFWORD(CHAR_LOWER
) {
6371 uint32_t c
= UFO_TOS
& 0xffU
;
6372 if (c
>= 'A' && c
<= 'Z') c
= c
- 'A' + 'a';
6377 // ( addr count -- )
6379 int32_t count
= (int32_t)ufoPop();
6380 uint32_t addr
= ufoPop();
6382 uint32_t c
= ufoImgGetU8(addr
);
6383 if (c
>= 'a' && c
<= 'z') {
6385 ufoImgPutU8(addr
, c
);
6387 addr
+= 1u; count
-= 1;
6392 // ( addr count -- )
6394 int32_t count
= (int32_t)ufoPop();
6395 uint32_t addr
= ufoPop();
6397 uint32_t c
= ufoImgGetU8(addr
);
6398 if (c
>= 'A' && c
<= 'Z') {
6400 ufoImgPutU8(addr
, c
);
6402 addr
+= 1u; count
-= 1;
6406 // STRING:(CHAR-DIGIT)
6407 // ( ch -- digit true // false )
6408 UFWORD(CHAR_DIGIT
) {
6410 const uint32_t c
= UFO_TOS
;
6411 if (c
>= '0' && c
<= '9') { UFO_TOS
= c
- '0'; ufoPushBool(1); }
6412 else if (c
>= 'A' && c
<= 'Z') { UFO_TOS
= c
- 'A' + 10; ufoPushBool(1); }
6413 else if (c
>= 'a' && c
<= 'z') { UFO_TOS
= c
- 'a' + 10; ufoPushBool(1); }
6418 // ( char base -- digit TRUE / FALSE )
6420 const uint32_t base
= ufoPop();
6422 if (base
> 0 && base
< 0x80000000u
) {
6423 uint32_t c
= UFO_TOS
;
6424 if (c
>= '0' && c
<= '9') c
= c
- '0';
6425 else if (c
>= 'A' && c
<= 'Z') c
= c
- 'A' + 10;
6426 else if (c
>= 'a' && c
<= 'z') c
= c
- 'a' + 10;
6427 else { UFO_TOS
= 0; return; }
6428 if (c
< base
) { UFO_TOS
= c
; ufoPushBool(1); } else UFO_TOS
= 0;
6435 // ( char base -- TRUE / FALSE )
6437 const uint32_t base
= ufoPop();
6439 if (base
> 0 && base
< 0x80000000u
) {
6440 uint32_t c
= UFO_TOS
;
6441 if (c
>= '0' && c
<= '9') c
= c
- '0';
6442 else if (c
>= 'A' && c
<= 'Z') c
= c
- 'A' + 10;
6443 else if (c
>= 'a' && c
<= 'z') c
= c
- 'a' + 10;
6444 else { UFO_TOS
= 0; return; }
6445 if (c
< base
) UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
6453 // ( addr1 addr2 size -- -1|0|1 )
6455 uint32_t count
= ufoPop();
6456 uint32_t addr1
= ufoPop();
6457 uint32_t addr0
= ufoPop();
6458 if ((count
& 0x80000000u
) == 0) {
6459 while (count
!= 0) {
6460 const int n
= (int)ufoImgGetU8(addr0
) - (int)ufoImgGetU8(addr1
);
6462 if (n
< 0) ufoPush(~(uint32_t)0); else ufoPush(1);
6465 addr0
+= 1u; addr1
+= 1u; count
-= 1u;
6469 ufoFatal("invalid MEMCMP counter");
6474 // ( addr1 addr2 size -- -1|0|1 )
6476 uint32_t count
= ufoPop();
6477 uint32_t addr1
= ufoPop();
6478 uint32_t addr0
= ufoPop();
6479 if ((count
& 0x80000000u
) == 0) {
6480 while (count
!= 0) {
6481 const int c0
= (int)toUpperU8(ufoImgGetU8(addr0
));
6482 const int c1
= (int)toUpperU8(ufoImgGetU8(addr1
));
6483 const int n
= c0
- c1
;
6485 if (n
< 0) ufoPush(~(uint32_t)0); else ufoPush(1);
6488 addr0
+= 1u; addr1
+= 1u; count
-= 1u;
6492 ufoFatal("invalid MEMCMP counter");
6497 // ( addr count u32 -- )
6498 UFWORD(FILL_CELLS
) {
6499 const uint32_t v
= ufoPop();
6500 uint32_t count
= ufoPop();
6501 uint32_t dest
= ufoPop();
6502 if ((count
& 0x80000000u
) == 0) {
6503 while (count
!= 0) {
6504 ufoImgPutU32(dest
, v
);
6505 dest
+= 4u; count
-= 1u;
6511 // ( addr count byte -- )
6513 const uint32_t v
= ufoPop() & 0xffU
;
6514 uint32_t count
= ufoPop();
6515 uint32_t dest
= ufoPop();
6516 if (count
!= 0 && (count
& 0x80000000u
) == 0) {
6517 while (count
!= 0 && (dest
& 3) != 0) {
6518 ufoImgPutU8(dest
, v
);
6519 dest
+= 1u; count
-= 1u;
6522 const uint32_t vv
= (v
<< 24) | (v
<< 16) | (v
<< 8) | v
;
6523 while (count
>= 4u) {
6524 ufoImgPutU32(dest
, vv
);
6525 dest
+= 4u; count
-= 4u;
6528 while (count
!= 0) {
6529 ufoImgPutU8(dest
, v
);
6530 dest
+= 1u; count
-= 1u;
6535 //==========================================================================
6539 //==========================================================================
6540 static void doCMoveFwd (uint32_t src
, uint32_t dest
, uint32_t count
) {
6542 if (count
!= 0 && (count
& 0x80000000u
) == 0 && src
!= dest
) {
6543 if ((src
& 3) == (dest
& 3)) {
6544 // we can align addresses
6545 while (count
!= 0 && (src
& 3) != 0) {
6546 v
= ufoImgGetU8(src
); ufoImgPutU8(dest
, v
);
6547 src
+= 1u; dest
+= 1u; count
-= 1u;
6549 // ...and move by whole cells
6550 while (count
>= 4u) {
6551 v
= ufoImgGetU32(src
); ufoImgPutU32(dest
, v
);
6552 src
+= 4u; dest
+= 4u; count
-= 4u;
6556 while (count
!= 0) {
6557 v
= ufoImgGetU8(src
); ufoImgPutU8(dest
, v
);
6558 src
+= 1u; dest
+= 1u; count
-= 1u;
6563 //==========================================================================
6567 //==========================================================================
6568 static void doCMoveBwd (uint32_t src
, uint32_t dest
, uint32_t count
) {
6569 if (count
!= 0 && (count
& 0x80000000u
) == 0 && src
!= dest
) {
6570 src
+= count
; dest
+= count
;
6571 while (count
!= 0) {
6572 src
-= 1u; dest
-= 1u; count
-= 1u;
6573 const uint8_t v
= ufoImgGetU8(src
); ufoImgPutU8(dest
, v
);
6579 // ( source dest count -- )
6580 UFWORD(CMOVE_CELLS_FWD
) {
6581 uint32_t count
= ufoPop();
6582 uint32_t dest
= ufoPop();
6583 uint32_t src
= ufoPop();
6584 if (count
!= 0 && (count
& 0x80000000u
) == 0 && src
!= dest
) {
6585 if (count
* 4u >= 0x80000000u
) ufoFatal("invalid CMOVE-CELLS counter");
6586 doCMoveFwd(src
, dest
, count
* 4u);
6591 // ( source dest count -- )
6592 UFWORD(CMOVE_CELLS_BWD
) {
6593 uint32_t count
= ufoPop();
6594 uint32_t dest
= ufoPop();
6595 uint32_t src
= ufoPop();
6596 if ((count
& 0x80000000u
) == 0) {
6597 src
+= count
* 4u; dest
+= count
* 4u;
6598 while (count
!= 0) {
6599 src
-= 4u; dest
-= 4u; count
-= 1u;
6600 const uint32_t v
= ufoImgGetU32(src
); ufoImgPutU32(dest
, v
);
6606 // ( source dest count -- )
6608 uint32_t count
= ufoPop();
6609 uint32_t dest
= ufoPop();
6610 uint32_t src
= ufoPop();
6611 doCMoveFwd(src
, dest
, count
);
6615 // ( source dest count -- )
6617 uint32_t count
= ufoPop();
6618 uint32_t dest
= ufoPop();
6619 uint32_t src
= ufoPop();
6620 doCMoveBwd(src
, dest
, count
);
6624 // ( source dest count -- )
6626 uint32_t count
= ufoPop();
6627 uint32_t dest
= ufoPop();
6628 uint32_t src
= ufoPop();
6629 if (count
!= 0 && (count
& 0x80000000u
) == 0 && src
!= dest
) {
6630 if (src
+ count
<= src
|| dest
+ count
<= dest
) ufoFatal("invalid MOVE");
6631 if (src
<= dest
&& src
+ count
> dest
) doCMoveBwd(src
, dest
, count
);
6632 else doCMoveFwd(src
, dest
, count
);
6637 // ////////////////////////////////////////////////////////////////////////// //
6638 // heavily used in UrAsm
6645 const uint32_t c
= UFO_TOS
& 0xffU
;
6646 if (c
>= '0' && c
<= '9') UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
6651 UFWORD(IS_BIN_DIGIT
) {
6653 const uint32_t c
= UFO_TOS
& 0xffU
;
6654 if (c
>= '0' && c
<= '1') UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
6659 UFWORD(IS_OCT_DIGIT
) {
6661 const uint32_t c
= UFO_TOS
& 0xffU
;
6662 if (c
>= '0' && c
<= '7') UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
6667 UFWORD(IS_HEX_DIGIT
) {
6669 const uint32_t c
= UFO_TOS
& 0xffU
;
6670 if ((c
>= '0' && c
<= '9') ||
6671 (c
>= 'A' && c
<= 'F') ||
6672 (c
>= 'a' && c
<= 'f')) UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
6679 const uint32_t c
= UFO_TOS
& 0xffU
;
6680 if ((c
>= 'A' && c
<= 'Z') ||
6681 (c
>= 'a' && c
<= 'z')) UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
6686 UFWORD(IS_UNDER_DOT
) {
6688 const uint32_t c
= UFO_TOS
& 0xffU
;
6689 if (c
== '_' || c
== '.') UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
6696 const uint32_t c
= UFO_TOS
& 0xffU
;
6697 if ((c
>= 'A' && c
<= 'Z') ||
6698 (c
>= 'a' && c
<= 'z') ||
6699 (c
>= '0' && c
<= '9')) UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
6704 UFWORD(IS_ID_START
) {
6706 const uint32_t c
= UFO_TOS
& 0xffU
;
6707 if ((c
>= 'A' && c
<= 'Z') ||
6708 (c
>= 'a' && c
<= 'z') ||
6709 c
== '_' || c
== '.') UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
6714 UFWORD(IS_ID_CHAR
) {
6716 const uint32_t c
= UFO_TOS
& 0xffU
;
6717 if ((c
>= 'A' && c
<= 'Z') ||
6718 (c
>= 'a' && c
<= 'z') ||
6719 (c
>= '0' && c
<= '9') ||
6720 c
== '_' || c
== '.') UFO_TOS
= ufoTrueValue
; else UFO_TOS
= 0;
6724 // ////////////////////////////////////////////////////////////////////////// //
6725 // conditional defines
6728 typedef struct UForthCondDefine_t UForthCondDefine
;
6729 struct UForthCondDefine_t
{
6733 UForthCondDefine
*next
;
6736 static UForthCondDefine
*ufoCondDefines
= NULL
;
6737 static char ufoErrMsgBuf
[4096];
6740 //==========================================================================
6744 //==========================================================================
6745 UFO_DISABLE_INLINE
int ufoStrEquCI (const void *str0
, const void *str1
) {
6746 const unsigned char *s0
= (const unsigned char *)str0
;
6747 const unsigned char *s1
= (const unsigned char *)str1
;
6748 while (*s0
&& *s1
) {
6749 if (toUpperU8(*s0
) != toUpperU8(*s1
)) return 0;
6752 return (*s0
== 0 && *s1
== 0);
6756 //==========================================================================
6760 //==========================================================================
6761 UFO_FORCE_INLINE
int ufoBufEquCI (uint32_t addr
, uint32_t count
, const void *buf
) {
6763 if ((count
& ((uint32_t)1<<31)) == 0) {
6764 const unsigned char *src
= (const unsigned char *)buf
;
6766 while (res
!= 0 && count
!= 0) {
6767 res
= (toUpperU8(*src
) == toUpperU8(ufoImgGetU8(addr
)));
6768 src
+= 1; addr
+= 1u; count
-= 1u;
6777 //==========================================================================
6779 // ufoClearCondDefines
6781 //==========================================================================
6782 static void ufoClearCondDefines (void) {
6783 while (ufoCondDefines
) {
6784 UForthCondDefine
*df
= ufoCondDefines
;
6785 ufoCondDefines
= df
->next
;
6786 if (df
->name
) free(df
->name
);
6792 //==========================================================================
6796 //==========================================================================
6797 int ufoHasCondDefine (const char *name
) {
6799 if (name
!= NULL
&& name
[0] != 0) {
6800 const size_t nlen
= strlen(name
);
6802 const uint32_t hash
= joaatHashBufCI(name
, nlen
);
6803 UForthCondDefine
*dd
= ufoCondDefines
;
6804 while (res
== 0 && dd
!= NULL
) {
6805 if (dd
->hash
== hash
&& dd
->namelen
== (uint32_t)nlen
) {
6806 res
= ufoStrEquCI(name
, dd
->name
);
6816 //==========================================================================
6820 //==========================================================================
6821 void ufoCondDefine (const char *name
) {
6822 if (name
!= NULL
&& name
[0] != 0) {
6823 const size_t nlen
= strlen(name
);
6824 if (nlen
> 255) ufoFatal("conditional define name too long");
6825 const uint32_t hash
= joaatHashBufCI(name
, nlen
);
6826 UForthCondDefine
*dd
= ufoCondDefines
;
6828 while (res
== 0 && dd
!= NULL
) {
6829 if (dd
->hash
== hash
&& dd
->namelen
== (uint32_t)nlen
) {
6830 res
= ufoStrEquCI(name
, dd
->name
);
6836 dd
= calloc(1, sizeof(UForthCondDefine
));
6837 if (dd
== NULL
) ufoFatal("out of memory for defines");
6838 dd
->name
= strdup(name
);
6839 if (dd
->name
== NULL
) { free(dd
); ufoFatal("out of memory for defines"); }
6840 dd
->namelen
= (uint32_t)nlen
;
6842 dd
->next
= ufoCondDefines
;
6843 ufoCondDefines
= dd
;
6849 //==========================================================================
6853 //==========================================================================
6854 void ufoCondUndef (const char *name
) {
6855 if (name
!= NULL
&& name
[0] != 0) {
6856 const size_t nlen
= strlen(name
);
6858 const uint32_t hash
= joaatHashBufCI(name
, nlen
);
6859 UForthCondDefine
*dd
= ufoCondDefines
;
6860 UForthCondDefine
*prev
= NULL
;
6861 while (dd
!= NULL
) {
6862 if (dd
->hash
== hash
&& dd
->namelen
== (uint32_t)nlen
) {
6863 if (ufoStrEquCI(name
, dd
->name
)) {
6864 if (prev
!= NULL
) prev
->next
= dd
->next
; else ufoCondDefines
= dd
->next
;
6870 if (dd
!= NULL
) { prev
= dd
; dd
= dd
->next
; }
6878 // ( addr count -- )
6879 UFWORD(PAR_DLR_DEFINE
) {
6880 uint32_t count
= ufoPop();
6881 uint32_t addr
= ufoPop();
6882 if (count
== 0) ufoFatal("empty define");
6883 if (count
>= UFO_MAX_WORD_LENGTH
) ufoFatal("define too long");
6884 const uint32_t hash
= ufoHashBuf(addr
, count
, 0x20);
6885 UForthCondDefine
*dd
;
6886 for (dd
= ufoCondDefines
; dd
!= NULL
; dd
= dd
->next
) {
6887 if (dd
->hash
== hash
&& dd
->namelen
== count
) {
6888 if (ufoBufEquCI(addr
, count
, dd
->name
)) return;
6892 dd
= calloc(1, sizeof(UForthCondDefine
));
6893 if (dd
== NULL
) ufoFatal("out of memory for defines");
6894 dd
->name
= calloc(1, count
+ 1u);
6895 if (dd
->name
== NULL
) { free(dd
); ufoFatal("out of memory for defines"); }
6896 for (uint32_t f
= 0; f
< count
; f
+= 1) {
6897 ((unsigned char *)dd
->name
)[f
] = ufoImgGetU8(addr
+ f
);
6899 dd
->namelen
= count
;
6901 dd
->next
= ufoCondDefines
;
6902 ufoCondDefines
= dd
;
6906 // ( addr count -- )
6907 UFWORD(PAR_DLR_UNDEF
) {
6908 uint32_t count
= ufoPop();
6909 uint32_t addr
= ufoPop();
6910 if (count
== 0) ufoFatal("empty define");
6911 if (count
>= UFO_MAX_WORD_LENGTH
) ufoFatal("define too long");
6912 const uint32_t hash
= ufoHashBuf(addr
, count
, 0x20);
6913 UForthCondDefine
*prev
= NULL
;
6914 UForthCondDefine
*dd
;
6915 for (dd
= ufoCondDefines
; dd
!= NULL
; prev
= dd
, dd
= dd
->next
) {
6916 if (dd
->hash
== hash
&& dd
->namelen
== count
) {
6917 if (ufoBufEquCI(addr
, count
, dd
->name
)) {
6918 if (prev
== NULL
) ufoCondDefines
= dd
->next
; else prev
->next
= dd
->next
;
6928 // ( addr count -- bool )
6929 UFWORD(PAR_DLR_DEFINEDQ
) {
6930 uint32_t count
= ufoPop();
6931 uint32_t addr
= ufoPop();
6932 if (count
== 0) ufoFatal("empty define");
6933 if (count
>= UFO_MAX_WORD_LENGTH
) ufoFatal("define too long");
6934 const uint32_t hash
= ufoHashBuf(addr
, count
, 0x20);
6936 UForthCondDefine
*dd
= ufoCondDefines
;
6937 while (!found
&& dd
!= NULL
) {
6938 if (dd
->hash
== hash
&& dd
->namelen
== count
) {
6939 found
= ufoBufEquCI(addr
, count
, dd
->name
);
6947 // ////////////////////////////////////////////////////////////////////////// //
6952 // ( addr count -- )
6954 uint32_t count
= ufoPop();
6955 uint32_t addr
= ufoPop();
6956 if (count
& (1u<<31)) ufoFatal("invalid error message");
6957 if (count
== 0) ufoFatal("some error");
6958 if (count
> (uint32_t)sizeof(ufoErrMsgBuf
) - 1u) count
= (uint32_t)sizeof(ufoErrMsgBuf
) - 1u;
6959 for (uint32_t f
= 0; f
< count
; f
+= 1) {
6960 ufoErrMsgBuf
[f
] = (char)ufoImgGetU8(addr
+ f
);
6962 ufoErrMsgBuf
[count
] = 0;
6963 ufoFatal("%s", ufoErrMsgBuf
);
6967 UFWORD(PAR_USER_ABORT
) {
6968 ufoFatal("user abort");
6972 // ( errflag addr count -- )
6983 // ( errflag addr count -- )
6986 if (UFO_S(2) == 0) {
6994 // ////////////////////////////////////////////////////////////////////////// //
6998 static char ufoFNameBuf
[4096];
7001 //==========================================================================
7003 // ufoScanIncludeFileName
7005 // `*psys` and `*psoft` must be initialised!
7007 //==========================================================================
7008 static void ufoScanIncludeFileName (uint32_t addr
, uint32_t count
, char *dest
, size_t destsz
,
7009 uint32_t *psys
, uint32_t *psoft
)
7013 ufo_assert(dest
!= NULL
);
7014 ufo_assert(destsz
> 0);
7016 while (count
!= 0) {
7017 ch
= ufoImgGetU8(addr
);
7019 //if (system) ufoFatal("invalid file name (duplicate system mark)");
7021 } else if (ch
== '?') {
7022 //if (softinclude) ufoFatal("invalid file name (duplicate soft mark)");
7028 addr
+= 1; count
-= 1;
7029 ch
= ufoImgGetU8(addr
);
7030 } while (ch
<= 32 && count
!= 0);
7033 if (count
== 0) ufoFatal("empty include file name");
7034 if (count
>= destsz
) ufoFatal("include file name too long");
7037 while (count
!= 0) {
7038 dest
[dpos
] = (char)ufoImgGetU8(addr
); dpos
+= 1;
7039 addr
+= 1; count
-= 1;
7045 // (INCLUDE-LINE-FOFS)
7047 UFWORD(PAR_INCLUDE_LINE_FOFS
) {
7048 ufoPush((uint32_t)(int32_t)ufoCurrIncludeLineFileOfs
);
7051 // (INCLUDE-LINE-SEEK)
7053 UFWORD(PAR_INCLUDE_LINE_SEEK
) {
7054 uint32_t fofs
= ufoPop();
7055 uint32_t lidx
= ufoPop();
7056 if (lidx
>= 0x0fffffffU
) lidx
= 0;
7057 if (ufoInFile
== NULL
) ufoFatal("cannot seek without opened include file");
7058 if (fseek(ufoInFile
, (long)fofs
, SEEK_SET
) != 0) {
7059 ufoFatal("error seeking in include file");
7061 ufoInFileLine
= lidx
;
7066 // return number of items in include stack
7067 UFWORD(PAR_INCLUDE_DEPTH
) {
7068 ufoPush(ufoFileStackPos
);
7071 // (INCLUDE-FILE-ID)
7072 // ( isp -- id ) -- isp 0 is current, then 1, etc.
7073 // each include file has unique non-zero id.
7074 UFWORD(PAR_INCLUDE_FILE_ID
) {
7075 const uint32_t isp
= ufoPop();
7078 } else if (isp
<= ufoFileStackPos
) {
7079 UFOFileStackEntry
*stk
= &ufoFileStack
[ufoFileStackPos
- isp
];
7082 ufoFatal("invalid include stack index");
7086 // (INCLUDE-FILE-LINE)
7088 UFWORD(PAR_INCLUDE_FILE_LINE
) {
7089 const uint32_t isp
= ufoPop();
7091 ufoPush(ufoInFileLine
);
7092 } else if (isp
<= ufoFileStackPos
) {
7093 UFOFileStackEntry
*stk
= &ufoFileStack
[ufoFileStackPos
- isp
];
7094 ufoPush(stk
->fline
);
7096 ufoFatal("invalid include stack index");
7100 // (INCLUDE-FILE-NAME)
7101 // ( isp -- addr count )
7102 // current file name; at PAD
7103 UFWORD(PAR_INCLUDE_FILE_NAME
) {
7104 const uint32_t isp
= ufoPop();
7105 const char *fname
= NULL
;
7107 fname
= ufoInFileName
;
7108 } else if (isp
<= ufoFileStackPos
) {
7109 UFOFileStackEntry
*stk
= &ufoFileStack
[ufoFileStackPos
- isp
];
7112 ufoFatal("invalid include stack index");
7114 uint32_t addr
= UFO_PAD_ADDR
+ 4u;
7116 if (fname
!= NULL
) {
7117 while (fname
[count
] != 0) {
7118 ufoImgPutU8(addr
+ count
, ((const unsigned char *)fname
)[count
]);
7122 ufoImgPutU32(addr
- 4u, count
);
7123 ufoImgPutU8(addr
+ count
, 0);
7129 // (INCLUDE-BUILD-NAME)
7130 // ( addr count soft? system? -- addr count )
7132 UFWORD(PAR_INCLUDE_BUILD_NAME
) {
7133 uint32_t system
= ufoPop();
7134 uint32_t softinclude
= ufoPop();
7135 uint32_t count
= ufoPop();
7136 uint32_t addr
= ufoPop();
7138 if ((count
& ((uint32_t)1<<31)) != 0) ufoFatal("invalid include name");
7140 ufoScanIncludeFileName(addr
, count
, ufoFNameBuf
, sizeof(ufoFNameBuf
),
7141 &system
, &softinclude
);
7143 char *ffn
= ufoCreateIncludeName(ufoFNameBuf
, system
, (system
? ufoLastSysIncPath
: ufoLastIncPath
));
7144 addr
= UFO_PAD_ADDR
+ 4u;
7146 while (ffn
[count
] != 0) {
7147 ufoImgPutU8(addr
+ count
, ((const unsigned char *)ffn
)[count
]);
7151 ufoImgPutU8(addr
+ count
, 0);
7152 ufoImgPutU32(addr
- 4u, count
);
7157 // (INCLUDE-NO-REFILL)
7158 // ( addr count soft? system? -- )
7159 UFWORD(PAR_INCLUDE_NO_REFILL
) {
7160 uint32_t system
= ufoPop();
7161 uint32_t softinclude
= ufoPop();
7162 uint32_t count
= ufoPop();
7163 uint32_t addr
= ufoPop();
7165 if (ufoMode
== UFO_MODE_MACRO
) ufoFatal("macros cannot include files");
7167 if ((count
& ((uint32_t)1<<31)) != 0) ufoFatal("invalid include name");
7169 ufoScanIncludeFileName(addr
, count
, ufoFNameBuf
, sizeof(ufoFNameBuf
),
7170 &system
, &softinclude
);
7172 char *ffn
= ufoCreateIncludeName(ufoFNameBuf
, system
, (system
? ufoLastSysIncPath
: ufoLastIncPath
));
7174 FILE *fl
= fopen(ffn
, "rb");
7176 FILE *fl
= fopen(ffn
, "r");
7179 if (softinclude
) { free(ffn
); return; }
7180 ufoFatal("include file '%s' not found", ffn
);
7182 #ifdef UFO_DEBUG_INCLUDE
7183 fprintf(stderr
, "INC-PUSH: new fname: %s\n", ffn
);
7188 ufoSetInFileNameReuse(ffn
);
7189 ufoFileId
= ufoLastUsedFileId
;
7190 setLastIncPath(ufoInFileName
, system
);
7195 UFWORD(PAR_INCLUDE_DROP
) {
7200 // ( addr count soft? system? -- )
7201 UFWORD(PAR_INCLUDE
) {
7202 UFCALL(PAR_INCLUDE_NO_REFILL
);
7203 // trigger next line loading
7205 if (!ufoPop()) ufoFatal("(INCLUDE) internal error");
7209 UFWORD(DLR_INCLUDE_IMM
) {
7210 int soft
= 0, system
= 0;
7211 // parse include filename
7212 ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS
);
7213 uint8_t ch
= ufoTibPeekCh();
7215 ufoTibSkipCh(); // skip quote
7217 } else if (ch
== '<') {
7218 ufoTibSkipCh(); // skip quote
7222 ufoFatal("expected quoted string");
7225 if (!ufoPop()) ufoFatal("file name expected");
7226 ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS
);
7227 if (ufoTibPeekCh() != 0) {
7228 ufoFatal("$INCLUDE doesn't accept extra args yet");
7230 // ( addr count soft? system? -- )
7231 ufoPushBool(soft
); ufoPushBool(system
); UFCALL(PAR_INCLUDE
);
7235 //==========================================================================
7237 // ufoCreateFileGuard
7239 //==========================================================================
7240 static const char *ufoCreateFileGuard (const char *fname
) {
7241 if (fname
== NULL
|| fname
[0] == 0) return NULL
;
7242 char *rp
= ufoRealPath(fname
);
7243 if (rp
== NULL
) return NULL
;
7245 for (char *s
= rp
; *s
; s
+= 1) if (*s
== '\\') *s
= '/';
7247 // hash the buffer; extract file name; create string with path len, file name, and hash
7248 const size_t orgplen
= strlen(rp
);
7249 const uint32_t phash
= joaatHashBuf(rp
, orgplen
, 0);
7250 size_t plen
= orgplen
;
7251 while (plen
!= 0 && rp
[plen
- 1u] != '/') plen
-= 1;
7252 snprintf(ufoRealPathHashBuf
, sizeof(ufoRealPathHashBuf
),
7253 "__INCLUDE_GUARD_%08X_%08X_%s__", phash
, (uint32_t)orgplen
, rp
+ plen
);
7254 return ufoRealPathHashBuf
;
7258 // $INCLUDE-ONCE "str"
7259 // includes file only once; unreliable on shitdoze, i believe
7260 UFWORD(DLR_INCLUDE_ONCE_IMM
) {
7261 uint32_t softinclude
= 0, system
= 0;
7262 // parse include filename
7263 ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS
);
7264 uint8_t ch
= ufoTibPeekCh();
7266 ufoTibSkipCh(); // skip quote
7268 } else if (ch
== '<') {
7269 ufoTibSkipCh(); // skip quote
7273 ufoFatal("expected quoted string");
7276 if (!ufoPop()) ufoFatal("file name expected");
7277 const uint32_t count
= ufoPop();
7278 const uint32_t addr
= ufoPop();
7279 ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS
);
7280 if (ufoTibPeekCh() != 0) {
7281 ufoFatal("$REQUIRE doesn't accept extra args yet");
7283 ufoScanIncludeFileName(addr
, count
, ufoRealPathHashBuf
, sizeof(ufoRealPathHashBuf
),
7284 &system
, &softinclude
);
7285 char *incfname
= ufoCreateIncludeName(ufoRealPathHashBuf
, system
, (system
? ufoLastSysIncPath
: ufoLastIncPath
));
7286 if (incfname
== NULL
) ufoFatal("cannot resolve include file '%s'", ufoRealPathHashBuf
);
7287 //fprintf(stderr, "?:%d;!:%d;%s|%s\n", softinclude, system, ufoRealPathHashBuf, incfname);
7288 // this will overwrite `ufoRealPathHashBuf`
7289 const char *guard
= ufoCreateFileGuard(incfname
);
7291 if (guard
== NULL
) {
7292 if (!softinclude
) ufoFatal("cannot include file '%s'", ufoRealPathHashBuf
);
7296 fprintf(stderr
, "GUARD: <%s>\n", guard
);
7298 // now check for the guard
7299 const uint32_t glen
= (uint32_t)strlen(guard
);
7300 const uint32_t ghash
= joaatHashBuf(guard
, glen
, 0);
7301 UForthCondDefine
*dd
;
7302 for (dd
= ufoCondDefines
; dd
!= NULL
; dd
= dd
->next
) {
7303 if (dd
->hash
== ghash
&& dd
->namelen
== glen
&& strcmp(guard
, dd
->name
) == 0) {
7304 // nothing to do: already included
7309 dd
= calloc(1, sizeof(UForthCondDefine
));
7310 if (dd
== NULL
) ufoFatal("out of memory for defines");
7311 dd
->name
= calloc(1, glen
+ 1u);
7312 if (dd
->name
== NULL
) { free(dd
); ufoFatal("out of memory for defines"); }
7313 strcpy(dd
->name
, guard
);
7316 dd
->next
= ufoCondDefines
;
7317 ufoCondDefines
= dd
;
7318 // ( addr count soft? system? -- )
7319 ufoPush(addr
); ufoPush(count
); ufoPushBool(softinclude
); ufoPushBool(system
);
7320 UFCALL(PAR_INCLUDE
);
7324 // ////////////////////////////////////////////////////////////////////////// //
7330 UFWORD(PAR_NEW_HANDLE
) {
7331 const uint32_t typeid = ufoPop();
7332 if (typeid == UFO_HANDLE_FREE
) ufoFatal("invalid handle typeid");
7333 UfoHandle
*hh
= ufoAllocHandle(typeid);
7334 ufoPush(hh
->ufoHandle
);
7339 UFWORD(PAR_FREE_HANDLE
) {
7340 const uint32_t hx
= ufoPop();
7342 if ((hx
& UFO_ADDR_HANDLE_BIT
) == 0) ufoFatal("trying to free something that is not a handle");
7343 UfoHandle
*hh
= ufoGetHandle(hx
);
7344 if (hh
== NULL
) ufoFatal("trying to free invalid handle");
7351 UFWORD(PAR_HANDLE_GET_TYPEID
) {
7352 const uint32_t hx
= ufoPop();
7353 if ((hx
& UFO_ADDR_HANDLE_BIT
) == 0) ufoFatal("not a handle");
7354 UfoHandle
*hh
= ufoGetHandle(hx
);
7355 if (hh
== NULL
) ufoFatal("invalid handle");
7356 ufoPush(hh
->typeid);
7361 UFWORD(PAR_HANDLE_SET_TYPEID
) {
7362 const uint32_t hx
= ufoPop();
7363 const uint32_t typeid = ufoPop();
7364 if ((hx
& UFO_ADDR_HANDLE_BIT
) == 0) ufoFatal("not a handle");
7365 if (typeid == UFO_HANDLE_FREE
) ufoFatal("invalid handle typeid");
7366 UfoHandle
*hh
= ufoGetHandle(hx
);
7367 if (hh
== NULL
) ufoFatal("invalid handle");
7368 hh
->typeid = typeid;
7373 UFWORD(PAR_HANDLE_GET_SIZE
) {
7374 const uint32_t hx
= ufoPop();
7376 if ((hx
& UFO_ADDR_HANDLE_BIT
) == 0) ufoFatal("not a handle");
7377 UfoHandle
*hh
= ufoGetHandle(hx
);
7378 if (hh
== NULL
) ufoFatal("invalid handle");
7387 UFWORD(PAR_HANDLE_SET_SIZE
) {
7388 const uint32_t hx
= ufoPop();
7389 const uint32_t size
= ufoPop();
7390 if (size
> 0x04000000) ufoFatal("invalid handle size");
7391 if ((hx
& UFO_ADDR_HANDLE_BIT
) == 0) ufoFatal("not a handle");
7392 UfoHandle
*hh
= ufoGetHandle(hx
);
7393 if (hh
== NULL
) ufoFatal("invalid handle");
7394 if (hh
->size
!= size
) {
7399 uint8_t *nx
= realloc(hh
->data
, size
* sizeof(hh
->data
[0]));
7400 if (nx
== NULL
) ufoFatal("out of memory for handle of size %u", size
);
7402 if (size
> hh
->size
) memset(hh
->data
, 0, size
- hh
->size
);
7405 if (hh
->used
> size
) hh
->used
= size
;
7411 UFWORD(PAR_HANDLE_GET_USED
) {
7412 const uint32_t hx
= ufoPop();
7414 if ((hx
& UFO_ADDR_HANDLE_BIT
) == 0) ufoFatal("not a handle");
7415 UfoHandle
*hh
= ufoGetHandle(hx
);
7416 if (hh
== NULL
) ufoFatal("invalid handle");
7425 UFWORD(PAR_HANDLE_SET_USED
) {
7426 const uint32_t hx
= ufoPop();
7427 const uint32_t used
= ufoPop();
7428 if (used
> 0x04000000) ufoFatal("invalid handle used");
7429 if ((hx
& UFO_ADDR_HANDLE_BIT
) == 0) ufoFatal("not a handle");
7430 UfoHandle
*hh
= ufoGetHandle(hx
);
7431 if (hh
== NULL
) ufoFatal("invalid handle");
7432 if (used
> hh
->size
) ufoFatal("handle used %u out of range (%u)", used
, hh
->size
);
7436 #define POP_PREPARE_HANDLE() \
7437 const uint32_t hx = ufoPop(); \
7438 uint32_t idx = ufoPop()
7442 // ( idx hx -- value )
7443 UFWORD(PAR_HANDLE_LOAD_BYTE
) {
7444 POP_PREPARE_HANDLE();
7445 ufoPush(ufoHandleLoadByte(hx
, idx
));
7449 // ( idx hx -- value )
7450 UFWORD(PAR_HANDLE_LOAD_WORD
) {
7451 POP_PREPARE_HANDLE();
7452 ufoPush(ufoHandleLoadWord(hx
, idx
));
7456 // ( idx hx -- value )
7457 UFWORD(PAR_HANDLE_LOAD_CELL
) {
7458 POP_PREPARE_HANDLE();
7459 ufoPush(ufoHandleLoadCell(hx
, idx
));
7463 // ( value idx hx -- value )
7464 UFWORD(PAR_HANDLE_STORE_BYTE
) {
7465 POP_PREPARE_HANDLE();
7466 const uint32_t value
= ufoPop();
7467 ufoHandleStoreByte(hx
, idx
, value
);
7471 // ( value idx hx -- )
7472 UFWORD(PAR_HANDLE_STORE_WORD
) {
7473 POP_PREPARE_HANDLE();
7474 const uint32_t value
= ufoPop();
7475 ufoHandleStoreWord(hx
, idx
, value
);
7479 // ( value idx hx -- )
7480 UFWORD(PAR_HANDLE_STORE_CELL
) {
7481 POP_PREPARE_HANDLE();
7482 const uint32_t value
= ufoPop();
7483 ufoHandleStoreCell(hx
, idx
, value
);
7488 // ( addr count -- stx / FALSE )
7489 UFWORD(PAR_HANDLE_LOAD_FILE
) {
7490 uint32_t count
= ufoPop();
7491 uint32_t addr
= ufoPop();
7493 if ((count
& ((uint32_t)1<<31)) != 0) ufoFatal("invalid file name");
7495 uint8_t *dest
= (uint8_t *)ufoFNameBuf
;
7496 while (count
!= 0 && dest
< (uint8_t *)ufoFNameBuf
+ sizeof(ufoFNameBuf
)) {
7497 uint8_t ch
= ufoImgGetU8(addr
);
7499 dest
+= 1u; addr
+= 1u; count
-= 1u;
7501 if (dest
== (uint8_t *)ufoFNameBuf
+ sizeof(ufoFNameBuf
)) ufoFatal("file name too long");
7504 if (*ufoFNameBuf
== 0) ufoFatal("empty file name");
7506 char *ffn
= ufoCreateIncludeName(ufoFNameBuf
, 0/*system*/, ufoLastIncPath
);
7508 FILE *fl
= fopen(ffn
, "rb");
7510 FILE *fl
= fopen(ffn
, "r");
7518 if (fseek(fl
, 0, SEEK_END
) != 0) {
7520 ufoFatal("seek error in file '%s'", ffn
);
7523 long sz
= ftell(fl
);
7524 if (sz
< 0 || sz
>= 1024 * 1024 * 64) {
7526 ufoFatal("tell error in file '%s' (or too big)", ffn
);
7529 if (fseek(fl
, 0, SEEK_SET
) != 0) {
7531 ufoFatal("seek error in file '%s'", ffn
);
7534 UfoHandle
*hh
= ufoAllocHandle(0);
7536 hh
->data
= malloc((uint32_t)sz
);
7537 if (hh
->data
== NULL
) {
7539 ufoFatal("out of memory for file '%s'", ffn
);
7541 hh
->size
= (uint32_t)sz
;
7542 if (fread(hh
->data
, (uint32_t)sz
, 1, fl
) != 1) {
7544 ufoFatal("error reading file '%s'", ffn
);
7550 ufoPush(hh
->ufoHandle
);
7554 // ////////////////////////////////////////////////////////////////////////// //
7558 #ifdef UFO_MTASK_ALLOWED
7559 #define UFO_MTASK_POP_STATE() \
7560 UfoState *st = ufoFindState(ufoPop()); \
7561 if (st == NULL) ufoFatal("unknown state")
7563 #define UFO_MTASK_POP_STATE() \
7564 if (ufoPop() != 0) ufoFatal("no multitasking support compiled in"); \
7565 UfoState *st = &ufoCurrState
7568 // DEBUG:(DECOMPILE-CFA)
7570 UFWORD(DEBUG_DECOMPILE_CFA
) {
7571 const uint32_t cfa
= ufoPop();
7573 ufoDecompileWord(cfa
);
7576 // DEBUG:(DECOMPILE-MEM)
7577 // ( addr-start addr-end -- )
7578 UFWORD(DEBUG_DECOMPILE_MEM
) {
7579 const uint32_t end
= ufoPop();
7580 const uint32_t start
= ufoPop();
7582 ufoDecompilePart(start
, end
, 0);
7588 ufoPush((uint32_t)ufo_get_msecs());
7591 // this is called by INTERPRET when it is out of input stream
7592 UFWORD(UFO_INTERPRET_FINISHED_ACTION
) {
7593 longjmp(ufoStopVMJP
, 666);
7596 #ifdef UFO_MTASK_ALLOWED
7599 UFWORD(MT_NEW_STATE
) {
7600 UfoState
*st
= ufoNewState();
7601 const uint32_t cfa
= ufoPop();
7602 const uint32_t cfaidx
= ufoImgGetU32(cfa
);
7603 if (cfaidx
!= ufoDoForthCFA
) ufoFatal("state starting word should be in Forth");
7604 ufoInitStateUserVars(st
);
7605 st
->ip
= UFO_CFA_TO_PFA(cfa
);
7606 st
->rStack
[0] = 0xdeadf00d; // dummy value
7613 UFWORD(MT_FREE_STATE
) {
7614 UfoState
*st
= ufoFindState(ufoPop());
7615 if (st
== NULL
) ufoFatal("cannot free unknown state");
7616 if (st
== ufoCurrState
) ufoFatal("cannot free current state");
7621 // MTASK:STATE-NAME@
7622 // ( stid -- addr count )
7624 UFWORD(MT_GET_STATE_NAME
) {
7625 UFO_MTASK_POP_STATE();
7626 uint32_t addr
= UFO_PAD_ADDR
;
7628 while (st
->name
[count
] != 0) {
7629 ufoImgPutU8(addr
+ count
, ((const unsigned char *)st
->name
)[count
]);
7632 ufoImgPutU8(addr
+ count
, 0);
7637 // MTASK:STATE-NAME!
7638 // ( addr count stid -- )
7639 UFWORD(MT_SET_STATE_NAME
) {
7640 UFO_MTASK_POP_STATE();
7641 uint32_t count
= ufoPop();
7642 uint32_t addr
= ufoPop();
7643 if ((count
& ((uint32_t)1 << 31)) == 0) {
7644 if (count
> UFO_MAX_TASK_NAME
) ufoFatal("task name too long");
7645 for (uint32_t f
= 0; f
< count
; f
+= 1u) {
7646 ((unsigned char *)st
->name
)[f
] = ufoImgGetU8(addr
+ f
);
7648 st
->name
[count
] = 0;
7652 #ifdef UFO_MTASK_ALLOWED
7653 // MTASK:STATE-FIRST
7655 UFWORD(MT_STATE_FIRST
) {
7657 while (fidx
!= (uint32_t)(UFO_MAX_STATES
/32) && ufoStateUsedBitmap
[fidx
] == 0) fidx
+= 1u;
7658 // there should be at least one allocated state
7659 ufo_assert(fidx
!= (uint32_t)(UFO_MAX_STATES
/32));
7660 uint32_t bmp
= ufoStateUsedBitmap
[fidx
];
7662 while ((bmp
& 0x01) == 0) { fidx
+= 1u; bmp
>>= 1; }
7667 // ( stid -- stid / 0 )
7668 UFWORD(MT_STATE_NEXT
) {
7669 uint32_t stid
= ufoPop();
7670 if (stid
!= 0 && stid
< (uint32_t)(UFO_MAX_STATES
/32)) {
7671 // it is already incremented for us, yay!
7672 uint32_t fidx
= stid
/ 32u;
7673 uint8_t fofs
= stid
& 0x1f;
7674 while (fidx
< (uint32_t)(UFO_MAX_STATES
/32)) {
7675 const uint32_t bmp
= ufoStateUsedBitmap
[fidx
];
7677 while (fofs
!= 32u) {
7678 if ((bmp
& ((uint32_t)1 << (fofs
& 0x1f))) == 0) fofs
+= 1u;
7681 ufoPush(fidx
* 32u + fofs
+ 1u);
7685 fidx
+= 1u; fofs
= 0;
7692 // ( ... argc stid -- )
7693 UFWORD(MT_YIELD_TO
) {
7694 UfoState
*st
= ufoFindState(ufoPop());
7695 if (st
== NULL
) ufoFatal("cannot yield to unknown state");
7696 //if (st == ufoDebuggerState) ufoFatal("cannot yield to debugger"); // why not?
7697 const uint32_t argc
= ufoPop();
7698 if (argc
> 256) ufoFatal("too many YIELD-TO arguments");
7699 UfoState
*curst
= ufoCurrState
;
7700 if (st
!= ufoCurrState
) {
7701 for (uint32_t f
= 0; f
< argc
; f
+= 1) {
7702 ufoCurrState
= curst
;
7703 const uint32_t n
= ufoPop();
7707 ufoCurrState
= curst
; // we need to use API call to switch states
7709 ufoSwitchToState(st
); // always use API call for this!
7714 // MTASK:SET-SELF-AS-DEBUGGER
7716 UFWORD(MT_SET_SELF_AS_DEBUGGER
) {
7717 ufoDebuggerState
= ufoCurrState
;
7720 // DEBUG:SINGLE-STEP@
7722 UFWORD(DBG_GET_SS
) {
7723 ufoPush(ufoSingleStepAllowed
);
7729 // debugger task receives debugge stid on the data stack, and -1 as argc.
7730 // i.e. debugger stask is: ( -1 old-stid )
7731 UFWORD(MT_DEBUGGER_BP
) {
7732 #ifdef UFO_MTASK_ALLOWED
7733 if (ufoDebuggerState
!= NULL
&& ufoCurrState
!= ufoDebuggerState
&& ufoIsGoodTTY()) {
7734 UfoState
*st
= ufoCurrState
;
7735 ufoSwitchToState(ufoDebuggerState
); // always use API call for this!
7740 UFCALL(UFO_BACKTRACE
);
7743 UFCALL(UFO_BACKTRACE
);
7747 #ifdef UFO_MTASK_ALLOWED
7748 // MTASK:DEBUGGER-RESUME
7750 UFWORD(MT_RESUME_DEBUGEE
) {
7751 if (ufoCurrState
!= ufoDebuggerState
) ufoFatal("cannot resume from non-debugger");
7752 UfoState
*st
= ufoFindState(ufoPop());
7753 if (st
== NULL
) ufoFatal("cannot yield to unknown state");
7754 if (st
== ufoCurrState
) ufoFatal("cannot resume into debugger itself");
7755 ufoSwitchToState(st
); // always use API call for this!
7759 // MTASK:DEBUGGER-SINGLE-STEP
7761 UFWORD(MT_SINGLE_STEP_DEBUGEE
) {
7762 if (ufoCurrState
!= ufoDebuggerState
) ufoFatal("cannot resume from non-debugger");
7763 UfoState
*st
= ufoFindState(ufoPop());
7764 if (st
== NULL
) ufoFatal("cannot yield to unknown state");
7765 if (st
== ufoCurrState
) ufoFatal("cannot resume into debugger itself");
7766 ufoSwitchToState(st
); // always use API call for this!
7767 ufoSingleStep
= 2; // it will be decremented after returning from this word
7773 UFWORD(MT_STATE_IP_GET
) {
7774 UFO_MTASK_POP_STATE();
7780 UFWORD(MT_STATE_IP_SET
) {
7781 UFO_MTASK_POP_STATE();
7787 UFWORD(MT_STATE_REGA_GET
) {
7788 UFO_MTASK_POP_STATE();
7794 UFWORD(MT_STATE_REGA_SET
) {
7795 UFO_MTASK_POP_STATE();
7796 st
->regA
= ufoPop();
7799 // MTASK:STATE-USER@
7800 // ( addr stid -- value )
7801 UFWORD(MT_STATE_USER_GET
) {
7802 UFO_MTASK_POP_STATE();
7803 const uint32_t addr
= ufoPop();
7804 if ((addr
& UFO_ADDR_TEMP_BIT
) != 0 && (addr
& UFO_ADDR_TEMP_MASK
) + 3u < ufoSTImageTempSize(st
)) {
7805 uint32_t v
= *(const uint32_t *)((const uint8_t *)st
->imageTemp
+ (addr
& UFO_ADDR_TEMP_MASK
));
7808 ufoFatal("invalid user area address");
7812 // MTASK:STATE-USER!
7813 // ( value addr stid -- )
7814 UFWORD(MT_STATE_USER_SET
) {
7815 UFO_MTASK_POP_STATE();
7816 const uint32_t addr
= ufoPop();
7817 const uint32_t value
= ufoPop();
7818 if ((addr
& UFO_ADDR_TEMP_BIT
) != 0 && (addr
& UFO_ADDR_TEMP_MASK
) + 3u < ufoSTImageTempSize(st
)) {
7819 *(uint32_t *)((const uint8_t *)st
->imageTemp
+ (addr
& UFO_ADDR_TEMP_MASK
)) = value
;
7821 ufoFatal("invalid user area address");
7825 // MTASK:ACTIVE-STATE
7827 UFWORD(MT_ACTIVE_STATE
) {
7828 #ifdef UFO_MTASK_ALLOWED
7829 ufoPush(ufoCurrState
->id
);
7835 // MTASK:YIELDED-FROM
7837 UFWORD(MT_YIELDED_FROM
) {
7838 #ifdef UFO_MTASK_ALLOWED
7839 if (ufoYieldedState
!= NULL
) {
7840 ufoPush(ufoYieldedState
->id
);
7850 // ( stid -- depth )
7851 UFWORD(MT_DSTACK_DEPTH_GET
) {
7852 UFO_MTASK_POP_STATE();
7857 // ( stid -- depth )
7858 UFWORD(MT_RSTACK_DEPTH_GET
) {
7859 UFO_MTASK_POP_STATE();
7866 UFO_MTASK_POP_STATE();
7872 UFWORD(MT_LBP_GET
) {
7873 UFO_MTASK_POP_STATE();
7878 // ( depth stid -- )
7879 UFWORD(MT_DSTACK_DEPTH_SET
) {
7880 UFO_MTASK_POP_STATE();
7881 const uint32_t idx
= ufoPop();
7882 if (idx
>= UFO_DSTACK_SIZE
) ufoFatal("invalid stack index %u (%u)", idx
, UFO_DSTACK_SIZE
);
7887 // ( depth stid -- )
7888 UFWORD(MT_RSTACK_DEPTH_SET
) {
7889 UFO_MTASK_POP_STATE();
7890 const uint32_t idx
= ufoPop();
7891 const uint32_t left
= UFO_RSTACK_SIZE
;
7892 if (idx
>= left
) ufoFatal("invalid rstack index %u (%u)", idx
, left
);
7899 UFO_MTASK_POP_STATE();
7905 UFWORD(MT_LBP_SET
) {
7906 UFO_MTASK_POP_STATE();
7911 // ( idx stid -- value )
7912 UFWORD(MT_DSTACK_LOAD
) {
7913 UFO_MTASK_POP_STATE();
7914 const uint32_t idx
= ufoPop();
7915 if (idx
>= st
->SP
) ufoFatal("invalid stack index %u (%u)", idx
, st
->SP
);
7916 ufoPush(st
->dStack
[st
->SP
- idx
- 1u]);
7920 // ( idx stid -- value )
7921 UFWORD(MT_RSTACK_LOAD
) {
7922 UFO_MTASK_POP_STATE();
7923 const uint32_t idx
= ufoPop();
7924 if (idx
>= st
->RP
) ufoFatal("invalid stack index %u (%u)", idx
, st
->RP
);
7925 ufoPush(st
->dStack
[st
->RP
- idx
- 1u]);
7929 // ( idx stid -- value )
7930 UFWORD(MT_LSTACK_LOAD
) {
7931 UFO_MTASK_POP_STATE();
7932 const uint32_t idx
= ufoPop();
7933 if (idx
>= st
->LP
) ufoFatal("invalid lstack index %u (%u)", idx
, st
->LP
);
7934 ufoPush(st
->lStack
[st
->LP
- idx
- 1u]);
7938 // ( value idx stid -- )
7939 UFWORD(MT_DSTACK_STORE
) {
7940 UFO_MTASK_POP_STATE();
7941 const uint32_t idx
= ufoPop();
7942 const uint32_t value
= ufoPop();
7943 if (idx
>= st
->SP
) ufoFatal("invalid stack index %u (%u)", idx
, st
->SP
);
7944 st
->dStack
[st
->SP
- idx
- 1u] = value
;
7948 // ( value idx stid -- )
7949 UFWORD(MT_RSTACK_STORE
) {
7950 UFO_MTASK_POP_STATE();
7951 const uint32_t idx
= ufoPop();
7952 const uint32_t value
= ufoPop();
7953 if (idx
>= st
->RP
) ufoFatal("invalid stack index %u (%u)", idx
, st
->RP
);
7954 st
->dStack
[st
->RP
- idx
- 1u] = value
;
7958 // ( value idx stid -- )
7959 UFWORD(MT_LSTACK_STORE
) {
7960 UFO_MTASK_POP_STATE();
7961 const uint32_t idx
= ufoPop();
7962 const uint32_t value
= ufoPop();
7963 if (idx
>= st
->LP
) ufoFatal("invalid stack index %u (%u)", idx
, st
->LP
);
7964 st
->dStack
[st
->LP
- idx
- 1u] = value
;
7969 UFWORD(MT_VSP_GET
) {
7970 UFO_MTASK_POP_STATE();
7976 UFWORD(MT_VSP_SET
) {
7977 UFO_MTASK_POP_STATE();
7978 const uint32_t vsp
= ufoPop();
7979 if (vsp
> UFO_VOCSTACK_SIZE
) ufoFatal("VSP %u out of range (%u)", vsp
, UFO_VOCSTACK_SIZE
);
7983 // MTASK:STATE-VSP-AT@
7984 // ( idx stidf -- value )
7985 UFWORD(MT_VSP_LOAD
) {
7986 UFO_MTASK_POP_STATE();
7987 const uint32_t vsp
= ufoPop();
7988 if (vsp
>= UFO_VOCSTACK_SIZE
) ufoFatal("VSP %u out of range (%u)", vsp
, UFO_VOCSTACK_SIZE
);
7989 ufoPush(st
->vocStack
[vsp
]);
7992 // MTASK:STATE-VSP-AT!
7993 // ( value idx stid -- )
7994 UFWORD(MT_VSP_STORE
) {
7995 UFO_MTASK_POP_STATE();
7996 const uint32_t vsp
= ufoPop();
7997 const uint32_t value
= ufoPop();
7998 if (vsp
> UFO_VOCSTACK_SIZE
) ufoFatal("VSP %u out of range (%u)", vsp
, UFO_VOCSTACK_SIZE
);
7999 st
->vocStack
[vsp
] = value
;
8003 #include "urforth_tty.c"
8006 // ////////////////////////////////////////////////////////////////////////// //
8010 static unsigned char ufoFileIOBuffer
[4096];
8013 //==========================================================================
8017 //==========================================================================
8018 static char *ufoPopFileName (void) {
8019 uint32_t count
= ufoPop();
8020 uint32_t addr
= ufoPop();
8022 if ((count
& 0x80000000U
) != 0) ufoFatal("invalid file name");
8023 if (count
== 0) ufoFatal("empty file name");
8024 if (count
> (uint32_t)sizeof(ufoFNameBuf
) - 1u) ufoFatal("file name too long");
8026 unsigned char *dest
= (unsigned char *)ufoFNameBuf
;
8027 while (count
!= 0) {
8028 *dest
= ufoImgGetU8(addr
);
8029 dest
+= 1u; addr
+= 1u; count
-= 1u;
8038 UFWORD(FILES_ERRNO
) {
8039 ufoPush((uint32_t)errno
);
8043 // ( addr count -- success? )
8044 UFWORD(FILES_UNLINK
) {
8045 const char *fname
= ufoPopFileName();
8046 ufoPushBool(unlink(fname
) == 0);
8050 // ( addr count -- handle TRUE / FALSE )
8051 UFWORD(FILES_OPEN_RO
) {
8052 const char *fname
= ufoPopFileName();
8053 const int fd
= open(fname
, O_RDONLY
);
8055 ufoPush((uint32_t)fd
);
8063 // ( addr count -- handle TRUE / FALSE )
8064 UFWORD(FILES_OPEN_RW
) {
8065 const char *fname
= ufoPopFileName();
8066 const int fd
= open(fname
, O_RDWR
);
8068 ufoPush((uint32_t)fd
);
8076 // ( addr count -- handle TRUE / FALSE )
8077 UFWORD(FILES_CREATE
) {
8078 const char *fname
= ufoPopFileName();
8079 //FIXME: add variable with default flags
8080 const int fd
= open(fname
, O_RDWR
|O_CREAT
|O_TRUNC
, 0644);
8082 ufoPush((uint32_t)fd
);
8090 // ( handle -- success? )
8091 UFWORD(FILES_CLOSE
) {
8092 const int32_t fd
= (int32_t)ufoPop();
8093 if (fd
< 0) ufoFatal("invalid file handle in 'CLOSE'");
8094 ufoPushBool(close(fd
) == 0);
8098 // ( handle -- ofs TRUE / FALSE )
8099 // `handle` cannot be 0.
8100 UFWORD(FILES_TELL
) {
8101 const int32_t fd
= (int32_t)ufoPop();
8102 if (fd
< 0) ufoFatal("invalid file handle in 'TELL'");
8103 const off_t pos
= lseek(fd
, 0, SEEK_CUR
);
8104 if (pos
!= (off_t
)-1) {
8105 ufoPush((uint32_t)pos
);
8113 // ( ofs whence handle -- TRUE / FALSE )
8114 // `handle` cannot be 0.
8115 UFWORD(FILES_SEEK_EX
) {
8116 const int32_t fd
= (int32_t)ufoPop();
8117 const uint32_t whence
= ufoPop();
8118 const uint32_t ofs
= ufoPop();
8119 if (fd
< 0) ufoFatal("invalid file handle in 'SEEK-EX'");
8120 if (whence
!= (uint32_t)SEEK_SET
&&
8121 whence
!= (uint32_t)SEEK_CUR
&&
8122 whence
!= (uint32_t)SEEK_END
) ufoFatal("invalid `whence` in 'SEEK-EX'");
8123 const off_t pos
= lseek(fd
, (off_t
)ofs
, (int)whence
);
8124 ufoPushBool(pos
!= (off_t
)-1);
8128 // ( handle -- size TRUE / FALSE )
8129 // `handle` cannot be 0.
8130 UFWORD(FILES_SIZE
) {
8131 const int32_t fd
= (int32_t)ufoPop();
8132 if (fd
< 0) ufoFatal("invalid file handle in 'SIZE'");
8133 const off_t origpos
= lseek(fd
, 0, SEEK_CUR
);
8134 if (origpos
== (off_t
)-1) {
8137 const off_t size
= lseek(fd
, 0, SEEK_END
);
8138 if (size
== (off_t
)-1) {
8139 (void)lseek(origpos
, 0, SEEK_SET
);
8141 } else if (lseek(origpos
, 0, SEEK_SET
) == origpos
) {
8142 ufoPush((uint32_t)size
);
8151 // ( addr count handle -- rdsize TRUE / FALSE )
8152 // `handle` cannot be 0.
8153 UFWORD(FILES_READ
) {
8154 const int32_t fd
= (int32_t)ufoPop();
8155 if (fd
< 0) ufoFatal("invalid file handle in 'READ'");
8156 uint32_t count
= ufoPop();
8157 uint32_t addr
= ufoPop();
8160 if ((count
& 0x80000000U
) != 0) ufoFatal("invalid number of bytes to read from file");
8161 while (count
!= done
) {
8162 uint32_t rd
= (uint32_t)sizeof(ufoFileIOBuffer
);
8163 if (rd
> count
) rd
= count
;
8165 const ssize_t xres
= read(fd
, ufoFileIOBuffer
, rd
);
8166 if (xres
>= 0) { rd
= (uint32_t)xres
; break; }
8167 if (errno
== EINTR
) continue;
8168 if (errno
== EAGAIN
|| errno
== EWOULDBLOCK
) { rd
= 0; break; }
8175 for (uint32_t f
= 0; f
!= rd
; f
+= 1u) {
8176 ufoImgPutU8(addr
, ufoFileIOBuffer
[f
]);
8186 // ( addr count handle -- TRUE / FALSE )
8187 // `handle` cannot be 0.
8188 UFWORD(FILES_READ_EXACT
) {
8189 const int32_t fd
= (int32_t)ufoPop();
8190 if (fd
< 0) ufoFatal("invalid file handle in 'READ-EXACT'");
8191 uint32_t count
= ufoPop();
8192 uint32_t addr
= ufoPop();
8194 if ((count
& 0x80000000U
) != 0) ufoFatal("invalid number of bytes to read from file");
8195 while (count
!= 0) {
8196 uint32_t rd
= (uint32_t)sizeof(ufoFileIOBuffer
);
8197 if (rd
> count
) rd
= count
;
8199 const ssize_t xres
= read(fd
, ufoFileIOBuffer
, rd
);
8200 if (xres
>= 0) { rd
= (uint32_t)xres
; break; }
8201 if (errno
== EINTR
) continue;
8202 if (errno
== EAGAIN
|| errno
== EWOULDBLOCK
) { rd
= 0; break; }
8207 if (rd
== 0) { ufoPushBool(0); return; } // still error
8209 for (uint32_t f
= 0; f
!= rd
; f
+= 1u) {
8210 ufoImgPutU8(addr
, ufoFileIOBuffer
[f
]);
8219 // ( addr count handle -- TRUE / FALSE )
8220 // `handle` cannot be 0.
8221 UFWORD(FILES_WRITE
) {
8222 const int32_t fd
= (int32_t)ufoPop();
8223 if (fd
< 0) ufoFatal("invalid file handle in 'WRITE'");
8224 uint32_t count
= ufoPop();
8225 uint32_t addr
= ufoPop();
8227 if ((count
& 0x80000000U
) != 0) ufoFatal("invalid number of bytes to write to file");
8228 while (count
!= 0) {
8229 uint32_t wr
= (uint32_t)sizeof(ufoFileIOBuffer
);
8230 if (wr
> count
) wr
= count
;
8231 for (uint32_t f
= 0; f
!= wr
; f
+= 1u) {
8232 ufoFileIOBuffer
[f
] = ufoImgGetU8(addr
+ f
);
8235 const ssize_t xres
= write(fd
, ufoFileIOBuffer
, wr
);
8236 if (xres
>= 0) { wr
= (uint32_t)xres
; break; }
8237 if (errno
== EINTR
) continue;
8238 fprintf(stderr
, "ERRNO: %d (fd=%d)\n", errno
, fd
);
8239 //if (errno == EAGAIN || errno == EWOULDBLOCK) { wr = 0; break; }
8244 if (wr
== 0) { ufoPushBool(1); return; } // still error
8245 count
-= wr
; addr
+= wr
;
8252 // ////////////////////////////////////////////////////////////////////////// //
8256 #ifdef UFO_MTASK_ALLOWED
8257 //==========================================================================
8261 // create a new state, its execution will start from the given CFA.
8262 // state is not automatically activated.
8264 //==========================================================================
8265 static UfoState
*ufoNewState (void) {
8266 // find free state id
8268 uint32_t bmp
= ufoStateUsedBitmap
[0];
8269 while (fidx
!= (uint32_t)(UFO_MAX_STATES
/32) && bmp
== ~(uint32_t)0) {
8271 bmp
= ufoStateUsedBitmap
[fidx
];
8273 if (fidx
== (uint32_t)(UFO_MAX_STATES
/32)) ufoFatal("too many execution states");
8274 //fprintf(stderr, "NST:000: fidx=%u; bmp=0x%08x\n", fidx, bmp);
8276 while ((bmp
& 0x01) != 0) { fidx
+= 1u; bmp
>>= 1; }
8277 ufo_assert(fidx
< UFO_MAX_STATES
);
8278 ufo_assert((ufoStateUsedBitmap
[fidx
/ 32u] & ((uint32_t)1 << (fidx
& 0x1f))) == 0);
8279 ufo_assert(ufoStateMap
[fidx
] == NULL
);
8280 UfoState
*st
= calloc(1, sizeof(UfoState
));
8281 if (st
== NULL
) ufoFatal("out of memory for states");
8283 ufoStateMap
[fidx
] = st
;
8284 ufoStateUsedBitmap
[fidx
/ 32u] |= ((uint32_t)1 << (fidx
& 0x1f));
8285 //fprintf(stderr, "NST: fidx=%u; 0x%08x\n", fidx, ufoStateUsedBitmap[fidx / 32u]);
8290 //==========================================================================
8294 // free all memory used for the state, remove it from state list.
8295 // WARNING! never free current state!
8297 //==========================================================================
8298 static void ufoFreeState (UfoState
*st
) {
8300 if (st
== ufoCurrState
) ufoFatal("cannot free active state");
8301 if (ufoYieldedState
== st
) ufoYieldedState
= NULL
;
8302 if (ufoDebuggerState
== st
) ufoDebuggerState
= NULL
;
8303 const uint32_t fidx
= st
->id
- 1u;
8304 //fprintf(stderr, "FST: fidx=%u; 0x%08x\n", fidx, ufoStateUsedBitmap[fidx / 32u]);
8305 ufo_assert(fidx
< UFO_MAX_STATES
);
8306 ufo_assert((ufoStateUsedBitmap
[fidx
/ 32u] & (1u << (fidx
& 0x1f))) != 0);
8307 ufo_assert(ufoStateMap
[fidx
] == st
);
8308 // free default TIB handle
8309 UfoState
*oldst
= ufoCurrState
;
8311 const uint32_t tib
= ufoImgGetU32(ufoAddrDefTIB
);
8312 if ((tib
& UFO_ADDR_TEMP_BIT
) != 0) {
8313 UfoHandle
*tibh
= ufoGetHandle(tib
);
8314 if (tibh
!= NULL
) ufoFreeHandle(tibh
);
8316 ufoCurrState
= oldst
;
8318 #ifndef UFO_HUGE_IMAGES
8319 if (st
->imageTemp
!= NULL
) free(st
->imageTemp
);
8322 ufoStateMap
[fidx
] = NULL
;
8323 ufoStateUsedBitmap
[fidx
/ 32u] &= ~((uint32_t)1 << (fidx
& 0x1f));
8328 //==========================================================================
8332 //==========================================================================
8333 static UfoState
*ufoFindState (uint32_t stid
) {
8334 UfoState
*res
= NULL
;
8335 if (stid
>= 0 && stid
<= UFO_MAX_STATES
) {
8338 ufo_assert(ufoCurrState
!= NULL
);
8339 stid
= ufoCurrState
->id
- 1u;
8343 res
= ufoStateMap
[stid
];
8345 ufo_assert((ufoStateUsedBitmap
[stid
/ 32u] & (1u << (stid
& 0x1f))) != 0);
8346 ufo_assert(res
->id
== stid
+ 1u);
8348 ufo_assert((ufoStateUsedBitmap
[stid
/ 32u] & (1u << (stid
& 0x1f))) == 0);
8355 //==========================================================================
8359 //==========================================================================
8360 static void ufoSwitchToState (UfoState
*newst
) {
8361 ufo_assert(newst
!= NULL
);
8362 if (newst
!= ufoCurrState
) {
8363 ufoCurrState
= newst
;
8369 // ////////////////////////////////////////////////////////////////////////// //
8370 // initial dictionary definitions
8375 #define UFWORD(name_) do { \
8376 const uint32_t xcfa_ = ufoCFAsUsed; \
8377 ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
8378 ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
8380 ufoDefineNative(""#name_, xcfa_, 0); \
8383 #define UFWORDX(strname_,name_) do { \
8384 const uint32_t xcfa_ = ufoCFAsUsed; \
8385 ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
8386 ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
8388 ufoDefineNative(strname_, xcfa_, 0); \
8391 #define UFWORD_IMM(name_) do { \
8392 const uint32_t xcfa_ = ufoCFAsUsed; \
8393 ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
8394 ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
8396 ufoDefineNative(""#name_, xcfa_, UFW_FLAG_IMMEDIATE); \
8399 #define UFWORDX_IMM(strname_,name_) do { \
8400 const uint32_t xcfa_ = ufoCFAsUsed; \
8401 ufo_assert(xcfa_ < UFO_MAX_NATIVE_CFAS); \
8402 ufoForthCFAs[xcfa_] = &ufoWord_##name_; \
8404 ufoDefineNative(strname_, xcfa_, UFW_FLAG_IMMEDIATE); \
8407 #define UFC(name_) ufoImgEmitU32_NoInline(ufoFindWordChecked(name_))
8410 //==========================================================================
8412 // ufoFindWordChecked
8414 //==========================================================================
8415 UFO_DISABLE_INLINE
uint32_t ufoFindWordChecked (const char *wname
) {
8416 const uint32_t cfa
= ufoFindWord(wname
);
8417 if (cfa
== 0) ufoFatal("word '%s' not found", wname
);
8422 //==========================================================================
8426 // get "FORTH" vocid
8428 //==========================================================================
8429 uint32_t ufoGetForthVocId (void) {
8430 return ufoForthVocId
;
8434 //==========================================================================
8436 // ufoVocSetOnlyDefs
8438 //==========================================================================
8439 void ufoVocSetOnlyDefs (uint32_t vocid
) {
8440 ufoImgPutU32(ufoAddrCurrent
, vocid
);
8441 ufoImgPutU32(ufoAddrContext
, vocid
);
8445 //==========================================================================
8449 // return voc PFA (vocid)
8451 //==========================================================================
8452 uint32_t ufoCreateVoc (const char *wname
, uint32_t parentvocid
, uint32_t flags
) {
8453 // create wordlist struct
8454 // typeid, used by Forth code (structs and such)
8455 ufoImgEmitU32(0); // typeid
8456 // vocid points here, to "LATEST-LFA"
8457 const uint32_t vocid
= UFO_GET_DP();
8458 //fprintf(stderr, "NEW VOCID (%s): 0x%08x\n", wname, vocid);
8459 ufoImgEmitU32(0); // latest
8460 const uint32_t vlink
= UFO_GET_DP();
8461 if ((vocid
& UFO_ADDR_TEMP_BIT
) == 0) {
8462 ufoImgEmitU32(ufoImgGetU32(ufoAddrVocLink
)); // voclink
8463 ufoImgPutU32(ufoAddrVocLink
, vlink
); // update voclink
8468 ufoImgEmitU32(parentvocid
); // parent
8469 const uint32_t hdraddr
= UFO_GET_DP();
8470 ufoImgEmitU32(0); // word header
8471 // create empty hash table
8472 for (int f
= 0; f
< UFO_HASHTABLE_SIZE
; f
+= 1) ufoImgEmitU32(0);
8473 // update CONTEXT and CURRENT if this is the first wordlist ever
8474 if (ufoImgGetU32(ufoAddrContext
) == 0) {
8475 ufoImgPutU32(ufoAddrContext
, vocid
);
8477 if (ufoImgGetU32(ufoAddrCurrent
) == 0) {
8478 ufoImgPutU32(ufoAddrCurrent
, vocid
);
8480 // create word header
8481 if (wname
!= NULL
&& wname
[0] != 0) {
8483 uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
8485 //UFW_FLAG_IMMEDIATE|
8487 //UFW_FLAG_NORETURN|
8493 flags |= UFW_FLAG_VOCAB;
8495 flags
&= 0xffffff00u
;
8496 flags
|= UFW_FLAG_VOCAB
;
8497 ufoCreateWordHeader(wname
, flags
);
8498 const uint32_t cfa
= UFO_GET_DP();
8499 ufoImgEmitCFA(ufoDoVocCFA
); // cfa
8500 ufoImgEmitU32(vocid
); // pfa
8501 // update vocab header pointer
8502 const uint32_t lfa
= UFO_CFA_TO_LFA(cfa
);
8503 ufoImgPutU32(hdraddr
, UFO_LFA_TO_NFA(lfa
));
8504 #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
8505 ufoDumpWordHeader(lfa
);
8512 //==========================================================================
8516 //==========================================================================
8517 static void ufoSetLatestArgs (uint32_t warg
) {
8518 const uint32_t curr
= ufoImgGetU32(ufoAddrCurrent
);
8519 const uint32_t lfa
= ufoImgGetU32(curr
);
8520 const uint32_t nfa
= UFO_LFA_TO_NFA(lfa
);
8521 uint32_t flags
= ufoImgGetU32(nfa
);
8522 //fprintf(stderr, "OLD FLAGS: 0x%08x\n", flags);
8523 flags
&= ~UFW_WARG_MASK
;
8524 flags
|= warg
& UFW_WARG_MASK
;
8525 //fprintf(stderr, "NEW FLAGS: 0x%08x\n", flags);
8526 ufoImgPutU32(nfa
, flags
);
8527 #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
8528 ufoDumpWordHeader(lfa
);
8533 //==========================================================================
8535 // ufoSetLatestFlags
8537 //==========================================================================
8538 static void ufoSetLatestFlags (uint32_t orflags
) {
8539 const uint32_t curr
= ufoImgGetU32(ufoAddrCurrent
);
8540 const uint32_t lfa
= ufoImgGetU32(curr
);
8541 const uint32_t nfa
= UFO_LFA_TO_NFA(lfa
);
8542 uint32_t flags
= ufoImgGetU32(nfa
);
8544 ufoImgPutU32(nfa
, flags
);
8545 #ifdef UFO_DEBUG_DUMP_NEW_HEADERS
8546 ufoDumpWordHeader(lfa
);
8551 //==========================================================================
8555 //==========================================================================
8556 static void ufoDefineNative (const char *wname
, uint32_t cfaidx
, uint32_t orflags
) {
8557 cfaidx
|= UFO_ADDR_CFA_BIT
;
8558 uint32_t flags
= ufoImgGetU32(ufoAddrNewWordFlags
);
8560 //UFW_FLAG_IMMEDIATE|
8562 //UFW_FLAG_NORETURN|
8568 //if (immed) flags |= UFW_FLAG_IMMEDIATE;
8570 ufoCreateWordHeader(wname
, flags
);
8571 ufoImgEmitCFA(cfaidx
);
8575 //==========================================================================
8577 // ufoDefineConstant
8579 //==========================================================================
8580 static void ufoDefineConstant (const char *name
, uint32_t value
) {
8581 ufoDefineNative(name
, ufoDoConstCFA
, 0);
8582 ufoImgEmitU32(value
);
8586 //==========================================================================
8590 //==========================================================================
8591 static void ufoDefineUserVar (const char *name
, uint32_t addr
) {
8592 ufoDefineNative(name
, ufoDoUserVariableCFA
, 0);
8593 ufoImgEmitU32(addr
);
8597 //==========================================================================
8601 //==========================================================================
8602 static void ufoDefineVar (const char *name
, uint32_t value
) {
8603 ufoDefineNative(name
, ufoDoVariableCFA
, 0);
8604 ufoImgEmitU32(value
);
8608 //==========================================================================
8612 //==========================================================================
8613 static void ufoDefineDefer (const char *name
, uint32_t value
) {
8614 ufoDefineNative(name
, ufoDoDeferCFA
, 0);
8615 ufoImgEmitU32(value
);
8619 //==========================================================================
8623 //==========================================================================
8624 static void ufoHiddenWords (void) {
8625 const uint32_t flags
= ufoImgGetU32(ufoAddrNewWordFlags
);
8626 ufoImgPutU32(ufoAddrNewWordFlags
, flags
| UFW_FLAG_HIDDEN
);
8630 //==========================================================================
8634 //==========================================================================
8635 static void ufoPublicWords (void) {
8636 const uint32_t flags
= ufoImgGetU32(ufoAddrNewWordFlags
);
8637 ufoImgPutU32(ufoAddrNewWordFlags
, flags
& ~UFW_FLAG_HIDDEN
);
8641 //==========================================================================
8645 //==========================================================================
8647 static void ufoDefineForth (const char *name) {
8648 ufoDefineNative(name, ufoDoForthCFA, 0);
8653 //==========================================================================
8655 // ufoDefineForthImm
8657 //==========================================================================
8659 static void ufoDefineForthImm (const char *name) {
8660 ufoDefineNative(name, ufoDoForthCFA, 1);
8665 //==========================================================================
8667 // ufoDefineForthHidden
8669 //==========================================================================
8671 static void ufoDefineForthHidden (const char *name) {
8672 const uint32_t flags = ufoImgGetU32(ufoAddrNewWordFlags);
8673 ufoImgPutU32(ufoAddrNewWordFlags, flags | UFW_FLAG_HIDDEN);
8674 ufoDefineNative(name, ufoDoForthCFA, 0);
8675 ufoImgPutU32(ufoAddrNewWordFlags, flags);
8680 //==========================================================================
8682 // ufoDefineSColonForth
8684 // create word suitable for scattered colon extension
8686 //==========================================================================
8687 static void ufoDefineSColonForth (const char *name
) {
8688 ufoDefineNative(name
, ufoDoForthCFA
, UFW_FLAG_SCOLON
);
8689 // placeholder for scattered colon
8690 // it will compile two branches:
8691 // the first branch will jump to the first "..:" word (or over the two branches)
8692 // the second branch is never taken, and works as a pointer to the latest branch addr in the list
8693 // this way, each extension word will simply fix the last branch address, and update list tail
8694 // at the creation time, second branch points to the first branch
8695 UFC("FORTH:(BRANCH)");
8696 const uint32_t xjmp
= UFO_GET_DP();
8698 UFC("FORTH:(BRANCH)");
8699 #ifdef UFO_RELATIVE_BRANCH
8700 ufoImgEmitU32(xjmp
- UFO_GET_DP()); // address of the fist branch dest
8701 ufoImgPutU32(xjmp
, UFO_GET_DP() - xjmp
); // jump over the jump
8703 ufoImgEmitU32(xjmp
);
8704 ufoImgPutU32(xjmp
, UFO_GET_DP());
8709 //==========================================================================
8713 //==========================================================================
8714 UFO_FORCE_INLINE
void ufoDoneForth (void) {
8715 UFC("FORTH:(EXIT)");
8719 //==========================================================================
8723 // compile string literal, the same as QUOTE_IMM
8725 //==========================================================================
8726 static void ufoCompileStrLitEx (const char *str
, const uint32_t slen
) {
8727 if (str
== NULL
) str
= "";
8728 if (slen
> 255) ufoFatal("string literal too long");
8729 UFC("FORTH:(LITSTR8)");
8730 ufoImgEmitU8((uint8_t)slen
);
8731 for (size_t f
= 0; f
< slen
; f
+= 1) {
8732 ufoImgEmitU8(((const unsigned char *)str
)[f
]);
8739 //==========================================================================
8743 //==========================================================================
8745 static void ufoCompileStrLit (const char *str) {
8746 ufoCompileStrLitEx(str, (uint32_t)strlen(str));
8751 //==========================================================================
8755 //==========================================================================
8756 static void ufoCompileLit (uint32_t value
) {
8758 ufoImgEmitU32(value
);
8762 //==========================================================================
8766 //==========================================================================
8768 static void ufoCompileCFALit (const char *wname) {
8769 UFC("FORTH:(LITCFA)");
8770 const uint32_t cfa = ufoFindWordChecked(wname);
8776 //==========================================================================
8780 //==========================================================================
8781 static int ufoXStrEquCI (const char *word
, const char *text
, uint32_t tlen
) {
8782 while (tlen
!= 0 && *word
) {
8783 if (toUpper(*word
) != toUpper(*text
)) return 0;
8784 word
+= 1u; text
+= 1u; tlen
-= 1u;
8786 return (tlen
== 0 && *word
== 0);
8790 #define UFO_MAX_LABEL_NAME (63)
8791 typedef struct UfoLabel_t
{
8794 char name
[UFO_MAX_LABEL_NAME
];
8795 uint32_t addr
; // jump chain tail, or address
8797 uint32_t word
; // is this a forward word definition?
8798 struct UfoLabel_t
*next
;
8801 static UfoLabel
*ufoLabels
= NULL
;
8804 //==========================================================================
8806 // ufoFindAddLabelEx
8808 //==========================================================================
8809 static UfoLabel
*ufoFindAddLabelEx (const char *name
, uint32_t namelen
, int allowAdd
) {
8810 if (namelen
== 0 || namelen
> UFO_MAX_LABEL_NAME
) ufoFatal("invalid label name");
8811 const uint32_t hash
= joaatHashBufCI(name
, namelen
);
8812 UfoLabel
*lbl
= ufoLabels
;
8813 while (lbl
!= NULL
) {
8814 if (lbl
->hash
== hash
&& lbl
->namelen
== namelen
) {
8817 while (ok
&& sidx
!= namelen
) {
8818 ok
= (toUpper(name
[sidx
]) == toUpper(lbl
->name
[sidx
]));
8827 lbl
= calloc(1, sizeof(UfoLabel
));
8829 lbl
->namelen
= namelen
;
8830 memcpy(lbl
->name
, name
, namelen
);
8831 lbl
->name
[namelen
] = 0;
8832 lbl
->next
= ufoLabels
;
8841 //==========================================================================
8845 //==========================================================================
8846 static UfoLabel
*ufoFindAddLabel (const char *name
, uint32_t namelen
) {
8847 return ufoFindAddLabelEx(name
, namelen
, 1);
8851 //==========================================================================
8855 //==========================================================================
8856 static UfoLabel
*ufoFindLabel (const char *name
, uint32_t namelen
) {
8857 return ufoFindAddLabelEx(name
, namelen
, 0);
8861 //==========================================================================
8863 // ufoTrySimpleNumber
8865 // only decimal and C-like hexes; with an optional sign
8867 //==========================================================================
8868 static int ufoTrySimpleNumber (const char *text
, uint32_t tlen
, uint32_t *num
) {
8871 if (tlen
!= 0 && *text
== '+') { text
+= 1u; tlen
-= 1u; }
8872 else if (tlen
!= 0 && *text
== '-') { neg
= 1; text
+= 1u; tlen
-= 1u; }
8874 int base
= 10; // default base
8875 if (tlen
> 2 && text
[0] == '0' && toUpper(text
[1]) == 'X') {
8878 text
+= 2u; tlen
-= 2u;
8881 if (tlen
== 0 || digitInBase(*text
, base
) < 0) return 0;
8888 if (!wasDigit
) return 0;
8891 dig
= digitInBase(*text
, base
);
8892 if (dig
< 0) return 0;
8894 n
= n
* (uint32_t)base
+ (uint32_t)dig
;
8896 text
+= 1u; tlen
-= 1u;
8899 if (!wasDigit
) return 0;
8900 if (neg
) n
= ~n
+ 1u;
8906 //==========================================================================
8908 // ufoEmitLabelChain
8910 //==========================================================================
8911 static void ufoEmitLabelChain (UfoLabel
*lbl
) {
8912 ufo_assert(lbl
!= NULL
);
8913 ufo_assert(lbl
->defined
== 0);
8914 const uint32_t here
= UFO_GET_DP();
8915 ufoImgEmitU32(lbl
->addr
);
8920 #ifdef UFO_RELATIVE_BRANCH
8921 #define UFO_XCOMPILER_BRANCH_SET(addr_,dest_) { \
8922 const uint32_t a = (addr_); \
8923 const uint32_t da = (dest_); \
8924 ufoImgPutU32(a, da - a); \
8927 #define UFO_XCOMPILER_BRANCH_SET(addr_,dest_) { \
8928 const uint32_t a = (addr_); \
8929 const uint32_t da = (dest_); \
8930 ufoImgPutU32(a, da); \
8935 //==========================================================================
8937 // ufoEmitLabelRefHere
8939 //==========================================================================
8940 UFO_FORCE_INLINE
void ufoEmitLabelRefHere (UfoLabel
*lbl
) {
8941 ufo_assert(lbl
!= NULL
);
8942 ufo_assert(lbl
->defined
!= 0);
8944 ufoImgEmitU32(lbl
->addr
);
8946 const uint32_t here
= UFO_GET_DP();
8948 UFO_XCOMPILER_BRANCH_SET(here
, lbl
->addr
);
8953 //==========================================================================
8955 // ufoFixLabelChainHere
8957 //==========================================================================
8958 static void ufoFixLabelChainHere (UfoLabel
*lbl
) {
8959 ufo_assert(lbl
!= NULL
);
8960 ufo_assert(lbl
->defined
== 0);
8961 const uint32_t here
= UFO_GET_DP();
8963 while (lbl
->addr
!= 0) {
8964 const uint32_t aprev
= ufoImgGetU32(lbl
->addr
);
8966 ufoImgPutU32(lbl
->addr
, here
);
8968 UFO_XCOMPILER_BRANCH_SET(lbl
->addr
, here
);
8976 #define UFO_MII_WORD_X_COMPILE (-5)
8977 #define UFO_MII_WORD_COMPILE_IMM (-4)
8978 #define UFO_MII_WORD_CFA_LIT (-3)
8979 #define UFO_MII_WORD_COMPILE (-2)
8980 #define UFO_MII_IN_WORD (-1)
8981 #define UFO_MII_NO_WORD (0)
8982 #define UFO_MII_WORD_NAME (1)
8983 #define UFO_MII_WORD_NAME_IMM (2)
8984 #define UFO_MII_WORD_NAME_HIDDEN (3)
8986 static int ufoMinInterpState
= UFO_MII_NO_WORD
;
8989 //==========================================================================
8991 // ufoFinalLabelCheck
8993 //==========================================================================
8994 static void ufoFinalLabelCheck (void) {
8996 if (ufoMinInterpState
!= UFO_MII_NO_WORD
) {
8997 ufoFatal("missing semicolon");
8999 while (ufoLabels
!= NULL
) {
9000 UfoLabel
*lbl
= ufoLabels
; ufoLabels
= lbl
->next
;
9001 if (!lbl
->defined
) {
9002 fprintf(stderr
, "UFO ERROR: label '%s' is not defined!\n", lbl
->name
);
9007 if (errorCount
!= 0) {
9008 ufoFatal("%d undefined label%s", errorCount
, (errorCount
!= 1 ? "s" : ""));
9013 //==========================================================================
9017 // this is so i could write Forth definitions more easily
9020 // $name -- reference
9021 // $name: -- definition
9023 //==========================================================================
9024 UFO_DISABLE_INLINE
void ufoInterpretLine (const char *line
) {
9025 char wname
[UFO_MAX_WORD_LENGTH
];
9026 uint32_t wlen
, num
, cfa
;
9029 if (*(const unsigned char *)line
<= 32) {
9031 } else if (ufoMinInterpState
== UFO_MII_WORD_CFA_LIT
||
9032 ufoMinInterpState
== UFO_MII_WORD_COMPILE
||
9033 ufoMinInterpState
== UFO_MII_WORD_COMPILE_IMM
||
9034 ufoMinInterpState
== UFO_MII_WORD_X_COMPILE
)
9036 // "[']"/"COMPILE"/"[COMPILE]" argument
9038 while (((const unsigned char *)line
)[wlen
] > 32) wlen
+= 1;
9039 if (wlen
>= UFO_MAX_WORD_LENGTH
) ufoFatal("word name too long");
9040 memcpy(wname
, line
, wlen
);
9042 switch (ufoMinInterpState
) {
9043 case UFO_MII_WORD_CFA_LIT
: UFC("FORTH:(LITCFA)"); break;
9044 case UFO_MII_WORD_COMPILE
: UFC("FORTH:(LITCFA)"); break;
9045 case UFO_MII_WORD_X_COMPILE
: UFC("FORTH:(LITCFA)"); break;
9046 case UFO_MII_WORD_COMPILE_IMM
: break;
9047 default: ufo_assert(0);
9049 cfa
= ufoFindWord(wname
);
9053 // forward reference
9054 lbl
= ufoFindAddLabel(line
, wlen
);
9055 if (lbl
->defined
|| (lbl
->word
== 0 && lbl
->addr
)) {
9056 ufoFatal("unknown word: '%s'", wname
);
9059 ufoEmitLabelChain(lbl
);
9061 switch (ufoMinInterpState
) {
9062 case UFO_MII_WORD_CFA_LIT
: break;
9063 case UFO_MII_WORD_COMPILE
: UFC("FORTH:COMPILE,"); break;
9064 case UFO_MII_WORD_X_COMPILE
: UFC("FORTH:,"); break;
9065 case UFO_MII_WORD_COMPILE_IMM
: break;
9066 default: ufo_assert(0);
9068 ufoMinInterpState
= UFO_MII_IN_WORD
;
9070 } else if (ufoMinInterpState
> UFO_MII_NO_WORD
) {
9073 while (((const unsigned char *)line
)[wlen
] > 32) wlen
+= 1;
9074 if (wlen
>= UFO_MAX_WORD_LENGTH
) ufoFatal("word name too long");
9075 if (wlen
> 2 && line
[0] == ':' && line
[wlen
- 1u] == ':') ufoFatal("invalid word name");
9076 memcpy(wname
, line
, wlen
);
9078 const uint32_t oldFlags
= ufoImgGetU32(ufoAddrNewWordFlags
);
9079 if (ufoMinInterpState
== UFO_MII_WORD_NAME_HIDDEN
) {
9080 ufoImgPutU32(ufoAddrNewWordFlags
, oldFlags
| UFW_FLAG_HIDDEN
);
9082 ufoDefineNative(wname
, ufoDoForthCFA
,
9083 (ufoMinInterpState
== UFO_MII_WORD_NAME_IMM
? UFW_FLAG_IMMEDIATE
: 0));
9084 ufoImgPutU32(ufoAddrNewWordFlags
, oldFlags
);
9085 ufoMinInterpState
= UFO_MII_IN_WORD
;
9086 // check for forward references
9087 lbl
= ufoFindLabel(line
, wlen
);
9089 if (lbl
->defined
|| !lbl
->word
) {
9090 ufoFatal("label/word conflict for '%.*s'", (unsigned)wlen
, line
);
9092 ufoFixLabelChainHere(lbl
);
9095 } else if ((line
[0] == ';' && line
[1] == ';') ||
9096 (line
[0] == '-' && line
[1] == '-') ||
9097 (line
[0] == '/' && line
[1] == '/') ||
9098 (line
[0] == '\\' && ((const unsigned char *)line
)[1] <= 32))
9100 ufoFatal("do not use single-line comments");
9101 } else if (line
[0] == '(' && ((const unsigned char *)line
)[1] <= 32) {
9102 while (*line
&& *line
!= ')') line
+= 1;
9103 if (*line
== ')') line
+= 1;
9107 while (((const unsigned char *)line
)[wlen
] > 32) wlen
+= 1;
9108 if (wlen
== 1 && (line
[0] == '"' || line
[0] == '`')) {
9110 const char qch
= line
[0];
9111 if (!line
[1]) ufoFatal("unterminated string literal");
9112 // skip quote and space
9113 if (((const unsigned char *)line
)[1] <= 32) line
+= 2u; else line
+= 1u;
9115 while (line
[wlen
] && line
[wlen
] != qch
) wlen
+= 1u;
9116 if (line
[wlen
] != qch
) ufoFatal("unterminated string literal");
9117 ufoCompileStrLitEx(line
, wlen
);
9118 line
+= wlen
+ 1u; // skip final quote
9119 } else if (wlen
== 1 && line
[0] == ':') {
9121 if (ufoMinInterpState
!= UFO_MII_NO_WORD
) ufoFatal("unexpected colon");
9122 ufoMinInterpState
= UFO_MII_WORD_NAME
;
9124 } else if (wlen
== 1 && line
[0] == ';') {
9126 if (ufoMinInterpState
!= UFO_MII_IN_WORD
) ufoFatal("unexpected semicolon");
9127 ufoImgEmitU32(ufoFindWordChecked("FORTH:(EXIT)"));
9128 ufoMinInterpState
= UFO_MII_NO_WORD
;
9130 } else if (wlen
== 2 && line
[0] == '!' && line
[1] == ':') {
9131 // new immediate word
9132 if (ufoMinInterpState
!= UFO_MII_NO_WORD
) ufoFatal("unexpected colon");
9133 ufoMinInterpState
= UFO_MII_WORD_NAME_IMM
;
9135 } else if (wlen
== 2 && line
[0] == '*' && line
[1] == ':') {
9137 if (ufoMinInterpState
!= UFO_MII_NO_WORD
) ufoFatal("unexpected colon");
9138 ufoMinInterpState
= UFO_MII_WORD_NAME_HIDDEN
;
9140 } else if (wlen
== 3 && memcmp(line
, "[']", 3) == 0) {
9142 if (ufoMinInterpState
!= UFO_MII_IN_WORD
) ufoFatal("unexpected immediate tick");
9143 ufoMinInterpState
= UFO_MII_WORD_CFA_LIT
;
9145 } else if (wlen
== 7 && ufoXStrEquCI("COMPILE", line
, wlen
)) {
9147 if (ufoMinInterpState
!= UFO_MII_IN_WORD
) ufoFatal("unexpected immediate tick");
9148 ufoMinInterpState
= UFO_MII_WORD_COMPILE
;
9150 } else if (wlen
== 9 && ufoXStrEquCI("X-COMPILE", line
, wlen
)) {
9152 if (ufoMinInterpState
!= UFO_MII_IN_WORD
) ufoFatal("unexpected immediate tick");
9153 ufoMinInterpState
= UFO_MII_WORD_X_COMPILE
;
9155 } else if (wlen
== 9 && ufoXStrEquCI("[COMPILE]", line
, wlen
)) {
9157 if (ufoMinInterpState
!= UFO_MII_IN_WORD
) ufoFatal("unexpected immediate tick");
9158 ufoMinInterpState
= UFO_MII_WORD_COMPILE_IMM
;
9162 if (wlen
>= UFO_MAX_WORD_LENGTH
) ufoFatal("word name too long");
9163 memcpy(wname
, line
, wlen
);
9165 cfa
= ufoFindWord(wname
);
9169 } else if (ufoTrySimpleNumber(line
, wlen
, &num
)) {
9170 // compile numeric literal
9173 // unknown word, this may be a forward reference, or a label definition
9174 // label defintion starts with "$"
9175 // (there are no words starting with "$" in the initial image)
9176 if (line
[0] == '$') {
9177 if (wlen
== 1) ufoFatal("dollar what?");
9178 if (wlen
> 2 && line
[wlen
- 1u] == ':') {
9180 lbl
= ufoFindAddLabel(line
, wlen
- 1u);
9181 if (lbl
->defined
) ufoFatal("double label '%s' definition", lbl
->name
);
9182 if (lbl
->word
) ufoFatal("double label '%s' word conflict", lbl
->name
);
9183 ufoFixLabelChainHere(lbl
);
9186 lbl
= ufoFindAddLabel(line
, wlen
);
9188 ufoEmitLabelRefHere(lbl
);
9190 ufoEmitLabelChain(lbl
);
9194 // forward reference
9195 lbl
= ufoFindAddLabel(line
, wlen
);
9196 if (lbl
->defined
|| (lbl
->word
== 0 && lbl
->addr
)) {
9197 ufoFatal("unknown word: '%s'", wname
);
9200 ufoEmitLabelChain(lbl
);
9210 //==========================================================================
9214 //==========================================================================
9215 UFO_DISABLE_INLINE
void ufoReset (void) {
9216 #ifdef UFO_MTASK_ALLOWED
9217 if (ufoCurrState
== NULL
) ufoFatal("no active execution state");
9220 ufoSP
= 0; ufoRP
= 0;
9221 ufoLP
= 0; ufoLBP
= 0;
9228 const uint32_t tib
= ufoImgGetU32(ufoAddrTIBx
);
9229 const uint32_t tibDef
= ufoImgGetU32(ufoAddrDefTIB
);
9230 #ifdef UFO_MTASK_ALLOWED
9231 ufoInitStateUserVars(ufoCurrState
);
9233 ufoInitStateUserVars(&ufoCurrState
);
9236 ufoImgPutU32(ufoAddrTIBx
, tib
);
9237 ufoImgPutU32(ufoAddrDefTIB
, tibDef
);
9238 ufoImgPutU32(ufoAddrRedefineWarning
, UFO_REDEF_WARN_NORMAL
);
9241 ufoImgPutU32(ufoAddrNewWordFlags
, 0);
9242 ufoVocSetOnlyDefs(ufoForthVocId
);
9246 //==========================================================================
9248 // ufoDefineEmitType
9250 //==========================================================================
9251 UFO_DISABLE_INLINE
void ufoDefineEmitType (void) {
9254 ufoInterpretLine(": EMIT ( ch -- ) (NORM-EMIT-CHAR) (EMIT) ;");
9258 ufoInterpretLine(": XEMIT ( ch -- ) (NORM-XEMIT-CHAR) (EMIT) ;");
9262 ufoInterpretLine(": CR ( -- ) NL (EMIT) ;");
9268 " LASTCR? FORTH:(TBRANCH) $endcr-exit CR "
9271 //ufoDecompileWord(ufoFindWordChecked("ENDCR"));
9275 ufoInterpretLine(": SPACE ( -- ) BL (EMIT) ;");
9280 ": SPACES ( count -- ) "
9282 " DUP 0> FORTH:(0BRANCH) $spaces-exit "
9284 " FORTH:(BRANCH) $spaces-again "
9290 // ( addr count -- )
9292 ": (TYPE) ( addr count -- ) "
9295 " DUP 0> FORTH:(0BRANCH) $par-type-exit "
9298 " FORTH:(BRANCH) $par-type-again "
9304 // ( addr count -- )
9306 ": TYPE ( addr count -- ) "
9309 " DUP 0> FORTH:(0BRANCH) $type-exit "
9312 " FORTH:(BRANCH) $type-again "
9318 // ( addr count -- )
9320 ": XTYPE ( addr count -- ) "
9323 " DUP 0> FORTH:(0BRANCH) $xtype-exit "
9326 " FORTH:(BRANCH) $xtype-again "
9332 // ( C:addr count -- ) ( E: -- addr count )
9334 ": STRLITERAL ( C:addr count -- ) ( E: -- addr count ) "
9335 " DUP 255 U> ` string literal too long` ?ERROR "
9336 " COMPILER:EXEC? FORTH:(TBRANCH) $strlit-exit "
9337 " HERE >R ( addr count | here ) "
9338 " X-COMPILE FORTH:(LITSTR8) "
9340 " ( compile length ) "
9342 " ( compile chars ) "
9344 " DUP FORTH:(0BRANCH) $strlit-loop-exit "
9346 " FORTH:(BRANCH) $strlit-loop "
9347 "$strlit-loop-exit: "
9349 " ( final 0: our counter is 0 here, so use it ) "
9351 " R> COMPILER:(AFTER-COMPILE-WORD) "
9356 // ( -- addr count )
9358 "!: \" ( -- addr count ) "
9359 " 34 PARSE ` string literal expected` ?NOT-ERROR "
9360 " COMPILER:(UNESCAPE) STRLITERAL "
9365 //==========================================================================
9367 // ufoDefineInterpret
9369 // define "INTERPRET" in Forth
9371 //==========================================================================
9372 UFO_DISABLE_INLINE
void ufoDefineInterpret (void) {
9373 UFWORDX("(UFO-INTERPRET-FINISHED-ACTION)", UFO_INTERPRET_FINISHED_ACTION
);
9375 // return "stop flag"
9377 "*: (UFO-INTERPRET-NEXT-LINE) ( -- continue? ) "
9378 " COMPILER:COMP? FORTH:(TBRANCH) $ipn_incomp "
9379 " ( interpreter allowed to cross include boundary ) "
9380 " REFILL FORTH:(BRANCH) $ipn_done "
9382 " ( compiler is not allowed to cross include boundary ) "
9383 " REFILL-NOCROSS ` compiler cannot cross file boundaries` ?NOT-ERROR "
9388 ufoInterpNextLineCFA
= ufoFindWordChecked("FORTH:(UFO-INTERPRET-NEXT-LINE)");
9389 ufoInterpretLine("*: (INTERPRET-NEXT-LINE) (USER-INTERPRET-NEXT-LINE) @ EXECUTE-TAIL ;");
9391 // skip comments, parse name, refilling lines if necessary
9392 // returning FALSE as counter means: "no addr, exit INTERPRET"
9394 "*: (INTERPRET-PARSE-NAME) ( -- addr count / FALSE ) "
9395 "$label_ipn_again: "
9396 " TRUE (PARSE-SKIP-COMMENTS) PARSE-NAME "
9397 " DUP FORTH:(TBRANCH) $label_ipn_exit_fwd "
9398 " 2DROP (INTERPRET-NEXT-LINE) "
9399 " FORTH:(TBRANCH) $label_ipn_again "
9401 "$label_ipn_exit_fwd: "
9403 //ufoDecompileWord(ufoFindWordChecked("(INTERPRET-PARSE-NAME)"));
9408 " FORTH:(INTERPRET-PARSE-NAME) ( addr count / FALSE )"
9409 " ?DUP FORTH:(0BRANCH) $interp-done "
9410 " ( try defered checker ) "
9411 " ( addr count FALSE -- addr count FALSE / TRUE ) "
9412 " FALSE (INTERPRET-CHECK-WORD) FORTH:(TBRANCH) $interp-again "
9413 " 2DUP FIND-WORD ( addr count cfa TRUE / addr count FALSE ) "
9414 " FORTH:(0BRANCH) $interp-try-number "
9416 " NROT 2DROP ( drop word string ) "
9417 " COMPILER:EXEC? FORTH:(TBRANCH) $interp-exec "
9418 " ( compiling; check immediate bit ) "
9419 " DUP CFA->NFA @ COMPILER:(WFLAG-IMMEDIATE) AND FORTH:(TBRANCH) $interp-exec "
9421 " FORTH:COMPILE, FORTH:(BRANCH) $interp-again "
9424 " EXECUTE FORTH:(BRANCH) $interp-again "
9425 " ( not a word, try a number ) "
9426 "$interp-try-number: "
9427 " 2DUP TRUE BASE @ (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE ) "
9428 " FORTH:(0BRANCH) $interp-number-error "
9430 " NROT 2DROP ( drop word string ) "
9431 " LITERAL FORTH:(BRANCH) $interp-again "
9433 "$interp-number-error: "
9434 " ( addr count FALSE -- addr count FALSE / TRUE ) "
9435 " FALSE (INTERPRET-WORD-NOT-FOUND) FORTH:(TBRANCH) $interp-again "
9436 " (INTERPRET-WORD-NOT-FOUND-POST) "
9437 " ENDCR SPACE XTYPE ` -- wut?` TYPE CR "
9438 " ` unknown word` ERROR "
9441 //ufoDecompileWord(ufoFindWordChecked("INTERPRET"));
9445 //==========================================================================
9449 //==========================================================================
9450 UFO_DISABLE_INLINE
void ufoInitBaseDict (void) {
9451 uint32_t imgAddr
= 0;
9453 // reserve 32 bytes for nothing
9454 for (uint32_t f
= 0; f
< 32; f
+= 1) {
9455 ufoImgPutU8(imgAddr
, 0);
9459 while ((imgAddr
& 3) != 0) {
9460 ufoImgPutU8(imgAddr
, 0);
9465 ufoAddrDP
= imgAddr
;
9466 ufoImgPutU32(imgAddr
, 0); imgAddr
+= 4u;
9469 ufoAddrLastXFA
= imgAddr
;
9470 ufoImgPutU32(imgAddr
, 0); imgAddr
+= 4u;
9473 ufoAddrVocLink
= imgAddr
;
9474 ufoImgPutU32(imgAddr
, 0); imgAddr
+= 4u;
9477 ufoAddrNewWordFlags
= imgAddr
;
9478 ufoImgPutU32(imgAddr
, UFW_FLAG_PROTECTED
); imgAddr
+= 4u;
9480 // WORD-REDEFINE-WARN-MODE
9481 ufoAddrRedefineWarning
= imgAddr
;
9482 ufoImgPutU32(imgAddr
, UFO_REDEF_WARN_NORMAL
); imgAddr
+= 4u;
9484 // setup (DP) and (DP-TEMP)
9485 ufoImgPutU32(ufoAddrDP
, imgAddr
);
9486 ufoImgPutU32(ufoAddrDPTemp
, UFO_DPTEMP_BASE_ADDR
);
9487 ufoImgPutU32(ufoAddrHereDP
, ufoAddrDP
);
9490 fprintf(stderr
, "INITIAL HERE: 0x%08x (0x%08x)\n", imgAddr
, UFO_GET_DP());
9495 //==========================================================================
9497 // ufoInitStateUserVars
9499 //==========================================================================
9500 static void ufoInitStateUserVars (UfoState
*st
) {
9501 ufo_assert(st
!= NULL
);
9502 #ifndef UFO_HUGE_IMAGES
9503 if (st
->imageTempSize
< 8192u) {
9504 uint32_t *itmp
= realloc(st
->imageTemp
, 8192);
9505 if (itmp
== NULL
) ufoFatal("out of memory for state user area");
9506 st
->imageTemp
= itmp
;
9507 memset((uint8_t *)st
->imageTemp
+ st
->imageTempSize
, 0, 8192u - st
->imageTempSize
);
9508 st
->imageTempSize
= 8192;
9511 st
->imageTemp
[(ufoAddrBASE
& UFO_ADDR_TEMP_MASK
) / 4u] = 10;
9512 st
->imageTemp
[(ufoAddrSTATE
& UFO_ADDR_TEMP_MASK
) / 4u] = 0;
9513 st
->imageTemp
[(ufoAddrUserVarUsed
& UFO_ADDR_TEMP_MASK
) / 4u] = ufoAddrUserVarUsed
;
9514 st
->imageTemp
[(ufoAddrDefTIB
& UFO_ADDR_TEMP_MASK
) / 4u] = UFO_DEF_TIB_ADDR
;
9515 st
->imageTemp
[(ufoAddrTIBx
& UFO_ADDR_TEMP_MASK
) / 4u] = UFO_DEF_TIB_ADDR
;
9516 st
->imageTemp
[(ufoAddrINx
& UFO_ADDR_TEMP_MASK
) / 4u] = 0;
9517 st
->imageTemp
[(ufoAddrContext
& UFO_ADDR_TEMP_MASK
) / 4u] = ufoForthVocId
;
9518 st
->imageTemp
[(ufoAddrCurrent
& UFO_ADDR_TEMP_MASK
) / 4u] = ufoForthVocId
;
9519 st
->imageTemp
[(ufoAddrSelf
& UFO_ADDR_TEMP_MASK
) / 4u] = 0;
9520 st
->imageTemp
[(ufoAddrInterNextLine
& UFO_ADDR_TEMP_MASK
) / 4u] = ufoInterpNextLineCFA
;
9521 st
->imageTemp
[(ufoAddrEP
& UFO_ADDR_TEMP_MASK
) / 4u] = 0;
9522 st
->imageTemp
[(ufoAddrDPTemp
& UFO_ADDR_TEMP_MASK
) / 4u] = UFO_DPTEMP_BASE_ADDR
;
9523 st
->imageTemp
[(ufoAddrHereDP
& UFO_ADDR_TEMP_MASK
) / 4u] = ufoAddrDP
;
9525 // init other things, because this procedure is used in `ufoReset()` too
9526 st
->SP
= 0; st
->RP
= 0; st
->regA
= 0;
9527 st
->LP
= 0; st
->LBP
= 0;
9532 //==========================================================================
9534 // ufoInitBasicWords
9536 //==========================================================================
9537 UFO_DISABLE_INLINE
void ufoInitBasicWords (void) {
9538 ufoDefineConstant("FALSE", 0);
9539 ufoDefineConstant("TRUE", ufoTrueValue
);
9541 ufoDefineConstant("BL", 32);
9542 ufoDefineConstant("NL", 10);
9544 UFWORDX("NOOP", NOOP
);
9545 UFWORDX("(NOTIMPL)", PAR_NOTIMPL
); ufoSetLatestFlags(UFW_FLAG_NORETURN
);
9548 ufoDefineUserVar("BASE", ufoAddrBASE
);
9549 ufoDefineUserVar("TIB", ufoAddrTIBx
);
9550 ufoDefineUserVar(">IN", ufoAddrINx
);
9551 ufoDefineUserVar("(STD-TIB-ADDR)", ufoAddrDefTIB
);
9552 ufoDefineUserVar("(USER-VAR-USED)", ufoAddrUserVarUsed
);
9553 ufoDefineConstant("(USER-VAR-ADDR)", UFO_ADDR_TEMP_BIT
);
9554 ufoDefineConstant("(USER-VAR-SIZE)", UFO_USER_AREA_SIZE
);
9555 ufoDefineConstant("(USER-TIB)", UFO_DEF_TIB_ADDR
);
9556 ufoDefineConstant("(USER-TIB-SIZE)", UFO_ADDR_HANDLE_OFS_MASK
);
9558 ufoDefineUserVar("STATE", ufoAddrSTATE
);
9559 ufoDefineConstant("CONTEXT", ufoAddrContext
);
9560 ufoDefineConstant("CURRENT", ufoAddrCurrent
);
9561 ufoDefineConstant("(SELF)", ufoAddrSelf
); // used in OOP implementations
9562 ufoDefineConstant("(USER-INTERPRET-NEXT-LINE)", ufoAddrInterNextLine
);
9563 ufoDefineConstant("(EXC-FRAME-PTR)", ufoAddrEP
);
9566 ufoDefineConstant("(LATEST-XFA)", ufoAddrLastXFA
);
9567 ufoDefineConstant("(VOC-LINK)", ufoAddrVocLink
);
9568 ufoDefineConstant("(NEW-WORD-FLAGS)", ufoAddrNewWordFlags
);
9569 ufoDefineConstant("(ADDR-TEMP-BIT)", UFO_ADDR_TEMP_BIT
);
9570 ufoDefineConstant("(ADDR-CFA-BIT)", UFO_ADDR_CFA_BIT
);
9571 ufoDefineConstant("(ADDR-HANDLE-BIT)", UFO_ADDR_HANDLE_BIT
);
9572 ufoDefineConstant("(MAX-HANDLE-OFS)", UFO_ADDR_HANDLE_OFS_MASK
);
9573 ufoDefineConstant("(DP-TEMP-BASE-ADDR))", UFO_DPTEMP_BASE_ADDR
);
9575 ufoDefineConstant("(PAD-ADDR)", UFO_PAD_ADDR
);
9576 ufoDefineConstant("(#BUF)", UFO_NBUF_ADDR
+ 4u); // reserve room for counter
9577 ufoDefineConstant("(#BUF-SIZE)", UFO_NBUF_SIZE
- 8u);
9579 ufoDefineConstant("(DP-MAIN)", ufoAddrDP
);
9580 ufoDefineConstant("(DP-TEMP)", ufoAddrDPTemp
); // in user vars
9581 ufoDefineConstant("(DP-HERE)", ufoAddrHereDP
); // in user vars
9584 //UFWORDX("(UFO-BUCKET-STATS)", PAR_UFO_BUCKET_STATS);
9585 UFWORDX("SP0!", SP0_STORE
);
9586 UFWORDX("RP0!", RP0_STORE
);
9588 UFWORDX("(SELF@)", PAR_SELF_LOAD
);
9589 UFWORDX("(SELF!)", PAR_SELF_STORE
);
9591 UFWORDX("PAD", PAD
);
9592 UFWORDX("HERE", HERE
);
9593 UFWORDX("ALIGN-HERE", ALIGN_HERE
);
9596 UFWORDX("C@", CPEEK
);
9597 UFWORDX("W@", WPEEK
);
9600 UFWORDX("C!", CPOKE
);
9601 UFWORDX("W!", WPOKE
);
9603 UFWORDX("(DIRECT:@)", DIRECT_PEEK
); ufoSetLatestArgs(UFW_WARG_PFA
);
9604 UFWORDX("(DIRECT:!)", DIRECT_POKE
); ufoSetLatestArgs(UFW_WARG_PFA
);
9605 UFWORDX("(DIRECT:0:!)", DIRECT_POKE0
); ufoSetLatestArgs(UFW_WARG_PFA
);
9606 UFWORDX("(DIRECT:1:!)", DIRECT_POKE1
); ufoSetLatestArgs(UFW_WARG_PFA
);
9607 UFWORDX("(DIRECT:-1:!)", DIRECT_POKEM1
); ufoSetLatestArgs(UFW_WARG_PFA
);
9608 UFWORDX("(DIRECT:+!)", DIRECT_ADD_POKE
); ufoSetLatestArgs(UFW_WARG_PFA
);
9609 UFWORDX("(DIRECT:-!)", DIRECT_SUB_POKE
); ufoSetLatestArgs(UFW_WARG_PFA
);
9610 UFWORDX("(DIRECT:+:@)", DIRECT_OFS_PEEK
); ufoSetLatestArgs(UFW_WARG_LIT
);
9611 UFWORDX("(DIRECT:+:!)", DIRECT_OFS_POKE
); ufoSetLatestArgs(UFW_WARG_LIT
);
9612 UFWORDX("(DIRECT:1+!)", DIRECT_POKE_INC1
); ufoSetLatestArgs(UFW_WARG_LIT
);
9613 UFWORDX("(DIRECT:2+!)", DIRECT_POKE_INC2
); ufoSetLatestArgs(UFW_WARG_LIT
);
9614 UFWORDX("(DIRECT:4+!)", DIRECT_POKE_INC4
); ufoSetLatestArgs(UFW_WARG_LIT
);
9615 UFWORDX("(DIRECT:8+!)", DIRECT_POKE_INC8
); ufoSetLatestArgs(UFW_WARG_LIT
);
9616 UFWORDX("(DIRECT:1-!)", DIRECT_POKE_DEC1
); ufoSetLatestArgs(UFW_WARG_LIT
);
9617 UFWORDX("(DIRECT:2-!)", DIRECT_POKE_DEC2
); ufoSetLatestArgs(UFW_WARG_LIT
);
9618 UFWORDX("(DIRECT:4-!)", DIRECT_POKE_DEC4
); ufoSetLatestArgs(UFW_WARG_LIT
);
9619 UFWORDX("(DIRECT:8-!)", DIRECT_POKE_DEC8
); ufoSetLatestArgs(UFW_WARG_LIT
);
9621 UFWORDX("(LIT-AND)", LIT_AND
); ufoSetLatestArgs(UFW_WARG_LIT
);
9622 UFWORDX("(LIT-~AND)", LIT_NAND
); ufoSetLatestArgs(UFW_WARG_LIT
);
9623 UFWORDX("(LIT-OR)", LIT_OR
); ufoSetLatestArgs(UFW_WARG_LIT
);
9624 UFWORDX("(LIT-XOR)", LIT_XOR
); ufoSetLatestArgs(UFW_WARG_LIT
);
9626 UFWORDX("0!", POKE_0
);
9627 UFWORDX("1!", POKE_1
);
9628 UFWORDX("1+!", POKE_INC_1
);
9629 UFWORDX("1-!", POKE_DEC_1
);
9630 UFWORDX("+!", POKE_INC
);
9631 UFWORDX("-!", POKE_DEC
);
9633 UFWORDX("SWAP!", SWAP_POKE
);
9634 UFWORDX("SWAP-C!", SWAP_CPOKE
);
9635 UFWORDX("SWAP-W!", SWAP_WPOKE
);
9636 UFWORDX("OR!", OR_POKE
);
9637 UFWORDX("OR-C!", OR_CPOKE
);
9638 UFWORDX("OR-W!", OR_WPOKE
);
9639 UFWORDX("XOR!", XOR_POKE
);
9640 UFWORDX("XOR-C!", XOR_CPOKE
);
9641 UFWORDX("XOR-W!", XOR_WPOKE
);
9642 UFWORDX("~AND!", NAND_POKE
);
9643 UFWORDX("~AND-C!", NAND_CPOKE
);
9644 UFWORDX("~AND-W!", NAND_WPOKE
);
9646 UFWORDX("COUNT", COUNT
);
9647 UFWORDX("BCOUNT", BCOUNT
);
9648 UFWORDX("ID-COUNT", ID_COUNT
);
9650 UFWORDX(",", COMMA
);
9651 UFWORDX("C,", CCOMMA
);
9652 UFWORDX("W,", WCOMMA
);
9654 UFWORDX("A>", REGA_LOAD
);
9655 UFWORDX(">A", REGA_STORE
);
9656 UFWORDX("A-SWAP", REGA_SWAP
);
9657 UFWORDX("+1>A", REGA_INC
);
9658 UFWORDX("+2>A", REGA_INC_WORD
);
9659 UFWORDX("+4>A", REGA_INC_CELL
);
9660 UFWORDX("-1>A", REGA_DEC
);
9661 UFWORDX("-2>A", REGA_DEC_WORD
);
9662 UFWORDX("-4>A", REGA_DEC_CELL
);
9663 UFWORDX("A>R", REGA_TO_R
);
9664 UFWORDX("R>A", R_TO_REGA
);
9666 UFWORDX("@A", PEEK_REGA
);
9667 UFWORDX("C@A", CPEEK_REGA
);
9668 UFWORDX("W@A", WPEEK_REGA
);
9670 UFWORDX("!A", POKE_REGA
);
9671 UFWORDX("C!A", CPOKE_REGA
);
9672 UFWORDX("W!A", WPOKE_REGA
);
9674 UFWORDX("@A+", PEEK_REGA_IDX
);
9675 UFWORDX("C@A+", CPEEK_REGA_IDX
);
9676 UFWORDX("W@A+", WPEEK_REGA_IDX
);
9678 UFWORDX("!A+", POKE_REGA_IDX
);
9679 UFWORDX("C!A+", CPOKE_REGA_IDX
);
9680 UFWORDX("W!A+", WPOKE_REGA_IDX
);
9682 UFWORDX("C!+1>A", CPOKE_REGA_INC1
);
9683 UFWORDX("W!+2>A", WPOKE_REGA_INC2
);
9684 UFWORDX("!+4>A", POKE_REGA_INC4
);
9685 UFWORDX("C@+1>A", CPEEK_REGA_INC1
);
9686 UFWORDX("W@+2>A", WPEEK_REGA_INC2
);
9687 UFWORDX("@+4>A", PEEK_REGA_INC4
);
9690 UFWORDX("(LIT)", PAR_LIT
); ufoSetLatestArgs(UFW_WARG_LIT
);
9691 UFWORDX("(LITCFA)", PAR_LITCFA
); ufoSetLatestArgs(UFW_WARG_CFA
);
9692 UFWORDX("(LITPFA)", PAR_LITPFA
); ufoSetLatestArgs(UFW_WARG_PFA
);
9693 UFWORDX("(LITVOCID)", PAR_LITVOCID
); ufoSetLatestArgs(UFW_WARG_VOCID
);
9694 UFWORDX("(LITSTR8)", PAR_LITSTR8
); ufoSetLatestArgs(UFW_WARG_C1STRZ
);
9695 UFWORDX("(EXIT)", PAR_EXIT
); ufoSetLatestFlags(UFW_FLAG_NORETURN
);
9697 ufoLitStr8CFA
= ufoFindWordChecked("FORTH:(LITSTR8)");
9699 UFWORDX("(L-ENTER)", PAR_LENTER
); ufoSetLatestArgs(UFW_WARG_LIT
);
9700 UFWORDX("(L-LEAVE)", PAR_LLEAVE
);
9701 UFWORDX("(LOCAL@)", PAR_LOCAL_LOAD
);
9702 UFWORDX("(LOCAL!)", PAR_LOCAL_STORE
);
9704 UFWORDX("(BRANCH)", PAR_BRANCH
); ufoSetLatestArgs(UFW_WARG_BRANCH
);
9705 UFWORDX("(TBRANCH)", PAR_TBRANCH
); ufoSetLatestArgs(UFW_WARG_BRANCH
); ufoSetLatestFlags(UFW_WARG_CONDBRANCH
);
9706 UFWORDX("(0BRANCH)", PAR_0BRANCH
); ufoSetLatestArgs(UFW_WARG_BRANCH
); ufoSetLatestFlags(UFW_WARG_CONDBRANCH
);
9707 UFWORDX("(+0BRANCH)", PAR_P0BRANCH
); ufoSetLatestArgs(UFW_WARG_BRANCH
); ufoSetLatestFlags(UFW_WARG_CONDBRANCH
);
9708 UFWORDX("(+BRANCH)", PAR_PBRANCH
); ufoSetLatestArgs(UFW_WARG_BRANCH
); ufoSetLatestFlags(UFW_WARG_CONDBRANCH
);
9709 UFWORDX("(-0BRANCH)", PAR_M0BRANCH
); ufoSetLatestArgs(UFW_WARG_BRANCH
); ufoSetLatestFlags(UFW_WARG_CONDBRANCH
);
9710 UFWORDX("(-BRANCH)", PAR_MBRANCH
); ufoSetLatestArgs(UFW_WARG_BRANCH
); ufoSetLatestFlags(UFW_WARG_CONDBRANCH
);
9711 UFWORDX("(DATASKIP)", PAR_DATASKIP
); ufoSetLatestArgs(UFW_WARG_DATASKIP
);
9712 UFWORDX("(OR-BRANCH)", PAR_OR_BRANCH
); ufoSetLatestArgs(UFW_WARG_BRANCH
); ufoSetLatestFlags(UFW_WARG_CONDBRANCH
);
9713 UFWORDX("(AND-BRANCH)", PAR_AND_BRANCH
); ufoSetLatestArgs(UFW_WARG_BRANCH
); ufoSetLatestFlags(UFW_WARG_CONDBRANCH
);
9714 UFWORDX("(?DUP-0BRANCH)", PAR_QDUP_0BRANCH
); ufoSetLatestArgs(UFW_WARG_BRANCH
); ufoSetLatestFlags(UFW_WARG_CONDBRANCH
);
9715 UFWORDX("(CASE-BRANCH)", PAR_CASE_BRANCH
); ufoSetLatestArgs(UFW_WARG_BRANCH
); ufoSetLatestFlags(UFW_WARG_CONDBRANCH
);
9720 //==========================================================================
9724 //==========================================================================
9725 UFO_DISABLE_INLINE
void ufoInitMoreWords (void) {
9726 UFWORDX("CFA->DOES-CFA", CFA2DOESCFA
);
9727 UFWORDX("CFA->PFA", CFA2PFA
);
9728 UFWORDX("CFA->NFA", CFA2NFA
);
9729 UFWORDX("CFA->LFA", CFA2LFA
);
9730 UFWORDX("CFA->WEND", CFA2WEND
);
9732 UFWORDX("PFA->CFA", PFA2CFA
);
9733 UFWORDX("PFA->NFA", PFA2NFA
);
9735 UFWORDX("NFA->CFA", NFA2CFA
);
9736 UFWORDX("NFA->PFA", NFA2PFA
);
9737 UFWORDX("NFA->LFA", NFA2LFA
);
9739 UFWORDX("LFA->CFA", LFA2CFA
);
9740 UFWORDX("LFA->PFA", LFA2PFA
);
9741 UFWORDX("LFA->BFA", LFA2BFA
);
9742 UFWORDX("LFA->XFA", LFA2XFA
);
9743 UFWORDX("LFA->YFA", LFA2YFA
);
9744 UFWORDX("LFA->NFA", LFA2NFA
);
9746 UFWORDX("(BASED-NUMBER)", PAR_BASED_NUMBER
);
9747 UFWORDX("FIND-WORD", FIND_WORD
);
9748 UFWORDX("(FIND-WORD-IN-VOC)", PAR_FIND_WORD_IN_VOC
);
9749 UFWORDX("(FIND-WORD-IN-VOC-AND-PARENTS)", PAR_FIND_WORD_IN_VOC_AND_PARENTS
);
9750 UFWORDX("FIND-WORD-IN-VOC", FIND_WORD_IN_VOC
);
9751 UFWORDX("FIND-WORD-IN-VOC-AND-PARENTS", FIND_WORD_IN_VOC_AND_PARENTS
);
9754 UFWORDX("EXECUTE-TAIL", EXECUTE_TAIL
); ufoSetLatestFlags(UFW_FLAG_NORETURN
);
9755 UFWORDX("@EXECUTE", LOAD_EXECUTE
);
9756 UFWORDX("@EXECUTE-TAIL", LOAD_EXECUTE_TAIL
); ufoSetLatestFlags(UFW_FLAG_NORETURN
);
9757 UFWORDX("(FORTH-CALL)", FORTH_CALL
);
9758 UFWORDX("(FORTH-TAIL-CALL)", FORTH_TAIL_CALL
); ufoSetLatestFlags(UFW_FLAG_NORETURN
);
9763 UFWORDX("?DUP", QDUP
);
9764 UFWORDX("2DUP", DDUP
);
9766 UFWORDX("2DROP", DDROP
);
9768 UFWORDX("2SWAP", DSWAP
);
9770 UFWORDX("2OVER", DOVER
);
9773 UFWORDX("PICK", PICK
);
9774 UFWORDX("ROLL", ROLL
);
9778 UFWORDX(">R", DTOR
);
9779 UFWORDX("R>", RTOD
);
9780 UFWORDX("R@", RPEEK
);
9781 UFWORDX("2>R", 2DTOR
);
9782 UFWORDX("2R>", 2RTOD
);
9783 UFWORDX("2R@", 2RPEEK
);
9784 UFWORDX("2RDROP", 2RDROP
);
9785 UFWORDX("RPICK", RPICK
);
9786 UFWORDX("RROLL", RROLL
);
9787 UFWORDX("RSWAP", RSWAP
);
9788 UFWORDX("ROVER", ROVER
);
9789 UFWORDX("RROT", RROT
);
9790 UFWORDX("RNROT", RNROT
);
9792 UFWORDX("FLUSH-EMIT", FLUSH_EMIT
);
9793 UFWORDX("(EMIT)", PAR_EMIT
);
9794 UFWORDX("(NORM-EMIT-CHAR)", PAR_NORM_EMIT_CHAR
);
9795 UFWORDX("(NORM-XEMIT-CHAR)", PAR_NORM_XEMIT_CHAR
);
9796 UFWORDX("LASTCR?", LASTCRQ
);
9797 UFWORDX("LASTCR!", LASTCRSET
);
9801 UFWORDX("-", MINUS
);
9803 UFWORDX("U*", UMUL
);
9805 UFWORDX("U/", UDIV
);
9806 UFWORDX("MOD", MOD
);
9807 UFWORDX("UMOD", UMOD
);
9808 UFWORDX("/MOD", DIVMOD
);
9809 UFWORDX("U/MOD", UDIVMOD
);
9810 UFWORDX("*/", MULDIV
);
9811 UFWORDX("U*/", UMULDIV
);
9812 UFWORDX("*/MOD", MULDIVMOD
);
9813 UFWORDX("U*/MOD", UMULDIVMOD
);
9814 UFWORDX("M*", MMUL
);
9815 UFWORDX("UM*", UMMUL
);
9816 UFWORDX("M/MOD", MDIVMOD
);
9817 UFWORDX("UM/MOD", UMDIVMOD
);
9818 UFWORDX("UDS*", UDSMUL
);
9820 UFWORDX("SM/REM", SMREM
);
9821 UFWORDX("FM/MOD", FMMOD
);
9823 UFWORDX("D-", DMINUS
);
9824 UFWORDX("D+", DPLUS
);
9825 UFWORDX("D=", DEQU
);
9826 UFWORDX("D<", DLESS
);
9827 UFWORDX("D<=", DLESSEQU
);
9828 UFWORDX("DU<", DULESS
);
9829 UFWORDX("DU<=", DULESSEQU
);
9837 UFWORDX("~AND", BN_AND
);
9838 UFWORDX("ABS", ABS
);
9839 UFWORDX("NEGATE", NEGATE
);
9840 UFWORDX("SIGN?", SIGNQ
);
9841 UFWORDX("LO-WORD", LO_WORD
);
9842 UFWORDX("HI-WORD", HI_WORD
);
9843 UFWORDX("LO-BYTE", LO_BYTE
);
9844 UFWORDX("HI-BYTE", HI_BYTE
);
9845 UFWORDX("MIN", MIN
);
9846 UFWORDX("MAX", MAX
);
9847 UFWORDX("UMIN", UMIN
);
9848 UFWORDX("UMAX", UMAX
);
9849 UFWORDX("WITHIN", WITHIN
);
9850 UFWORDX("UWITHIN", UWITHIN
);
9851 UFWORDX("BOUNDS?", BOUNDSQ
);
9852 UFWORDX("BSWAP16", BSWAP16
);
9853 UFWORDX("BSWAP32", BSWAP32
);
9856 UFWORDX("(SWAP:1+:SWAP)", PAR_SWAP_INC_SWAP
);
9860 UFWORDX(">", GREAT
);
9861 UFWORDX("<=", LESSEQU
);
9862 UFWORDX(">=", GREATEQU
);
9863 UFWORDX("U<", ULESS
);
9864 UFWORDX("U>", UGREAT
);
9865 UFWORDX("U<=", ULESSEQU
);
9866 UFWORDX("U>=", UGREATEQU
);
9868 UFWORDX("<>", NOTEQU
);
9870 UFWORDX("0=", ZERO_EQU
);
9871 UFWORDX("0<>", ZERO_NOTEQU
);
9872 UFWORDX("0<", 0LESS
);
9873 UFWORDX("0>", 0GREAT
);
9874 UFWORDX("0<=", 0LESSEQU
);
9875 UFWORDX("0>=", 0GREATEQU
);
9877 UFWORDX("NOT", ZERO_EQU
);
9878 UFWORDX("NOTNOT", ZERO_NOTEQU
);
9884 UFWORDX("LOGAND", LOGAND
);
9885 UFWORDX("LOGOR", LOGOR
);
9887 UFWORDX("2*", 2MUL
);
9888 UFWORDX("4*", 4MUL
);
9889 UFWORDX("8*", 8MUL
);
9890 UFWORDX("2/", 2DIV
);
9891 UFWORDX("4/", 4DIV
);
9892 UFWORDX("8/", 8DIV
);
9893 UFWORDX("2U/", 2UDIV
);
9894 UFWORDX("4U/", 4UDIV
);
9895 UFWORDX("8U/", 8UDIV
);
9897 UFWORDX("1+", 1ADD
);
9898 UFWORDX("1-", 1SUB
);
9899 UFWORDX("2+", 2ADD
);
9900 UFWORDX("2-", 2SUB
);
9901 UFWORDX("4+", 4ADD
);
9902 UFWORDX("4-", 4SUB
);
9903 UFWORDX("8+", 8ADD
);
9904 UFWORDX("8-", 8SUB
);
9906 ufoDefineConstant("CELL", 4);
9908 UFWORDX("CELL+", 4ADD
);
9909 UFWORDX("CELL-", 4SUB
);
9911 UFWORDX("CELLS", 4MUL
);
9912 UFWORDX("/CELLS", 4DIV
);
9913 UFWORDX("+CELLS", ADD_CELLS
);
9914 UFWORDX("-CELLS", SUB_CELLS
);
9916 UFWORDX("MEMCMP", MEMCMP
);
9917 UFWORDX("MEMCMP-CI", MEMCMP_CI
);
9919 UFWORDX("CMOVE-CELLS", CMOVE_CELLS_FWD
);
9920 UFWORDX("CMOVE>-CELLS", CMOVE_CELLS_BWD
);
9921 UFWORDX("CMOVE", CMOVE_FWD
);
9922 UFWORDX("CMOVE>", CMOVE_BWD
);
9923 UFWORDX("MOVE", MOVE
);
9925 UFWORDX("FILL-CELLS", FILL_CELLS
);
9926 UFWORDX("FILL", FILL
);
9929 UFWORDX("(TIB-IN)", TIB_IN
);
9930 UFWORDX("TIB-PEEKCH", TIB_PEEKCH
);
9931 UFWORDX("TIB-PEEKCH-OFS", TIB_PEEKCH_OFS
);
9932 UFWORDX("TIB-GETCH", TIB_GETCH
);
9933 UFWORDX("TIB-SKIPCH", TIB_SKIPCH
);
9935 UFWORDX("REFILL", REFILL
);
9936 UFWORDX("REFILL-NOCROSS", REFILL_NOCROSS
);
9939 UFWORDX("(PARSE)", PAR_PARSE
);
9940 UFWORDX("(PARSE-SKIP-COMMENTS)", PAR_PARSE_SKIP_COMMENTS
);
9942 UFWORDX("PARSE-SKIP-BLANKS", PARSE_SKIP_BLANKS
);
9943 UFWORDX("PARSE-NAME", PARSE_NAME
);
9944 UFWORDX("PARSE-SKIP-LINE", PARSE_SKIP_LINE
);
9945 UFWORDX("PARSE", PARSE
);
9948 UFWORDX("(VSP@)", PAR_GET_VSP
);
9949 UFWORDX("(VSP!)", PAR_SET_VSP
);
9950 UFWORDX("(VSP-AT@)", PAR_VSP_LOAD
);
9951 UFWORDX("(VSP-AT!)", PAR_VSP_STORE
);
9952 ufoDefineConstant("(VSP-SIZE)", UFO_VOCSTACK_SIZE
);
9954 ufoDefineConstant("(SP-SIZE)", UFO_DSTACK_SIZE
);
9955 ufoDefineConstant("(RP-SIZE)", UFO_RSTACK_SIZE
);
9956 ufoDefineConstant("(LP-SIZE)", UFO_LSTACK_SIZE
);
9959 UFWORDX("ERROR", ERROR
); ufoSetLatestFlags(UFW_FLAG_NORETURN
);
9960 UFWORDX("FATAL-ERROR", ERROR
); ufoSetLatestFlags(UFW_FLAG_NORETURN
);
9961 UFWORDX("(USER-ABORT)", PAR_USER_ABORT
); ufoSetLatestFlags(UFW_FLAG_NORETURN
);
9963 ufoUserAbortCFA
= ufoImgGetU32(ufoAddrCurrent
);
9964 ufoUserAbortCFA
= ufoImgGetU32(ufoUserAbortCFA
+ UFW_VOCAB_OFS_LATEST
);
9965 ufoUserAbortCFA
= UFO_LFA_TO_CFA(ufoUserAbortCFA
);
9967 UFWORDX("?ERROR", QERROR
); ufoSetLatestFlags(UFW_FLAG_MAYRETURN
);
9968 UFWORDX("?NOT-ERROR", QNOTERROR
); ufoSetLatestFlags(UFW_FLAG_MAYRETURN
);
9972 ufoInterpretLine(": ABORT ` \"ABORT\" called` ERROR ;"); ufoSetLatestFlags(UFW_FLAG_NORETURN
);
9974 UFWORDX("GET-MSECS", GET_MSECS
);
9978 //==========================================================================
9980 // ufoInitBasicCompilerWords
9982 //==========================================================================
9983 UFO_DISABLE_INLINE
void ufoInitBasicCompilerWords (void) {
9984 // create "COMPILER" vocabulary
9985 ufoCompilerVocId
= ufoCreateVoc("COMPILER", 0, UFW_FLAG_PROTECTED
);
9986 ufoVocSetOnlyDefs(ufoCompilerVocId
);
9988 ufoDefineConstant("(CFAIDX-DO-FORTH)", ufoDoForthCFA
);
9989 ufoDefineConstant("(CFAIDX-DO-VAR)", ufoDoVariableCFA
);
9990 ufoDefineConstant("(CFAIDX-DO-VALUE)", ufoDoValueCFA
);
9991 ufoDefineConstant("(CFAIDX-DO-CONST)", ufoDoConstCFA
);
9992 ufoDefineConstant("(CFAIDX-DO-DEFER)", ufoDoDeferCFA
);
9993 ufoDefineConstant("(CFAIDX-DO-DOES)", ufoDoDoesCFA
);
9994 ufoDefineConstant("(CFAIDX-DO-REDIRECT)", ufoDoRedirectCFA
);
9995 ufoDefineConstant("(CFAIDX-DO-VOC)", ufoDoVocCFA
);
9996 ufoDefineConstant("(CFAIDX-DO-CREATE)", ufoDoCreateCFA
);
9997 ufoDefineConstant("(CFAIDX-DO-USER-VAR)", ufoDoUserVariableCFA
);
9999 ufoDefineConstant("(WFLAG-IMMEDIATE)", UFW_FLAG_IMMEDIATE
);
10000 ufoDefineConstant("(WFLAG-SMUDGE)", UFW_FLAG_SMUDGE
);
10001 ufoDefineConstant("(WFLAG-NORETURN)", UFW_FLAG_NORETURN
);
10002 ufoDefineConstant("(WFLAG-HIDDEN)", UFW_FLAG_HIDDEN
);
10003 ufoDefineConstant("(WFLAG-CBLOCK)", UFW_FLAG_CBLOCK
);
10004 ufoDefineConstant("(WFLAG-VOCAB)", UFW_FLAG_VOCAB
);
10005 ufoDefineConstant("(WFLAG-SCOLON)", UFW_FLAG_SCOLON
);
10006 ufoDefineConstant("(WFLAG-PROTECTED)", UFW_FLAG_PROTECTED
);
10007 ufoDefineConstant("(WFLAG-CONDBRANCH)", UFW_WARG_CONDBRANCH
);
10008 ufoDefineConstant("(WFLAG-MAYRETURN)", UFW_FLAG_MAYRETURN
);
10010 ufoDefineConstant("(WARG-MASK)", UFW_WARG_MASK
);
10011 ufoDefineConstant("(WARG-NONE)", UFW_WARG_NONE
);
10012 ufoDefineConstant("(WARG-BRANCH)", UFW_WARG_BRANCH
);
10013 ufoDefineConstant("(WARG-LIT)", UFW_WARG_LIT
);
10014 ufoDefineConstant("(WARG-C4STRZ)", UFW_WARG_C4STRZ
);
10015 ufoDefineConstant("(WARG-CFA)", UFW_WARG_CFA
);
10016 ufoDefineConstant("(WARG-CBLOCK)", UFW_WARG_CBLOCK
);
10017 ufoDefineConstant("(WARG-VOCID)", UFW_WARG_VOCID
);
10018 ufoDefineConstant("(WARG-C1STRZ)", UFW_WARG_C1STRZ
);
10019 ufoDefineConstant("(WARG-DATASKIP)", UFW_WARG_DATASKIP
);
10020 ufoDefineConstant("(WARG-PFA)", UFW_WARG_PFA
);
10022 ufoDefineConstant("(VOCOFS-LATEST)", UFW_VOCAB_OFS_LATEST
);
10023 ufoDefineConstant("(VOCOFS-VOCLINK)", UFW_VOCAB_OFS_VOCLINK
);
10024 ufoDefineConstant("(VOCOFS-PARENT)", UFW_VOCAB_OFS_PARENT
);
10025 ufoDefineConstant("(VOCOFS-HEADER)", UFW_VOCAB_OFS_HEADER
);
10026 ufoDefineConstant("(VOCOFS-HTABLE)", UFW_VOCAB_OFS_HTABLE
);
10027 ufoDefineConstant("(VOC-HTABLE-SIZE)", UFO_HASHTABLE_SIZE
);
10028 ufoDefineConstant("(VOC-HTABLE-NOFLAG)", UFO_NO_HTABLE_FLAG
);
10030 ufoDefineConstant("(REDEFINE-WARN-DON'T-CARE)", UFO_REDEF_WARN_DONT_CARE
);
10031 ufoDefineConstant("(REDEFINE-WARN-NONE)", UFO_REDEF_WARN_NONE
);
10032 ufoDefineConstant("(REDEFINE-WARN-NORMAL)", UFO_REDEF_WARN_NORMAL
);
10033 ufoDefineConstant("(REDEFINE-WARN-PARENTS)", UFO_REDEF_WARN_PARENTS
);
10035 ufoDefineConstant("WORD-REDEFINE-WARN-MODE", ufoAddrRedefineWarning
);
10037 UFWORDX("(BRANCH-ADDR!)", PAR_BRANCH_ADDR_POKE
);
10038 UFWORDX("(BRANCH-ADDR@)", PAR_BRANCH_ADDR_PEEK
);
10040 UFWORDX("CFA,", CFA_COMMA
);
10041 UFWORDX("(UNESCAPE)", PAR_UNESCAPE
);
10043 const uint32_t dropCFA
= ufoFindWordChecked("FORTH:DROP");
10044 const uint32_t noopCFA
= ufoFindWordChecked("FORTH:NOOP");
10046 ufoDefineDefer("(AFTER-COMPILE-WORD)", dropCFA
); // ( start-addr -- )
10047 ufoDefineDefer("(AFTER-COMPILE-LIT)", dropCFA
); // ( start-addr -- )
10048 ufoDefineDefer("(JUMP-HERE-MARKED)", noopCFA
); // ( -- )
10049 ufoDefineDefer("(RESET-SINOPT)", noopCFA
); // ( -- )
10051 ufoDefineVar("(COMPILE-START-HERE)", 0);
10055 " FORTH:STATE FORTH:@ ` expecting interpretation mode` FORTH:?ERROR "
10060 " FORTH:STATE FORTH:@ ` expecting compilation mode` FORTH:?NOT-ERROR "
10064 ": EXEC? ( -- bool ) "
10065 " FORTH:STATE FORTH:@ FORTH:0= "
10069 ": COMP? ( -- bool ) "
10070 " FORTH:STATE FORTH:@ FORTH:0<> "
10075 " FORTH:STATE FORTH:0! "
10080 " FORTH:STATE FORTH:1! "
10083 UFWORDX("(CREATE-WORD-HEADER)", PAR_CREATE_WORD_HEADER
);
10084 UFWORDX("(CREATE-NAMELESS-WORD-HEADER)", PAR_CREATE_NAMELESS_WORD_HEADER
);
10086 ufoVocSetOnlyDefs(ufoForthVocId
);
10089 ufoInterpretLine("!: [ COMPILER:?COMP COMPILER:EXEC! ;");
10091 ufoInterpretLine(": ] COMPILER:?EXEC COMPILER:COMP! ;");
10094 ": COMPILE, ( n -- ) "
10095 " COMPILER:(COMPILE-START-HERE) @ ` compile sequence is not finished... somewhere` ?ERROR "
10096 " HERE >R , R> COMPILER:(AFTER-COMPILE-WORD) "
10100 ": <COMPILE, ( n -- ) "
10101 " COMPILER:(COMPILE-START-HERE) @ ` compile sequence is not finished... somewhere` ?ERROR "
10102 " HERE COMPILER:(COMPILE-START-HERE) ! , "
10106 ": COMPILE> ( n -- ) "
10107 " COMPILER:(COMPILE-START-HERE) @ DUP ` compile sequence is not started... somewhere` ?NOT-ERROR "
10108 " COMPILER:(COMPILE-START-HERE) 0! COMPILER:(AFTER-COMPILE-WORD) "
10112 // ( C:n -- ) ( E:n -- n )
10114 ": LITERAL ( C:n -- ) ( E:n -- n ) "
10115 " COMPILER:COMP? FORTH:(0BRANCH) $literal_exit "
10116 " HERE >R X-COMPILE FORTH:(LIT) , "
10117 " R> COMPILER:(AFTER-COMPILE-LIT) "
10120 //ufoDecompileWord(ufoFindWordChecked("LITERAL"));
10123 // ( C:cfa -- ) ( E:cfa -- cfa )
10125 ": CFALITERAL ( C:cfa -- ) ( E:cfa -- cfa ) "
10126 " COMPILER:COMP? FORTH:(0BRANCH) $cfa_literal_exit "
10127 " HERE >R X-COMPILE FORTH:(LITCFA) , "
10128 " R> COMPILER:(AFTER-COMPILE-LIT) "
10129 "$cfa_literal_exit: "
10133 // ( C:pfa -- ) ( E:pfa -- pfa )
10135 ": PFALITERAL ( C:pfa -- ) ( E:pfa -- pfa ) "
10136 " COMPILER:COMP? FORTH:(0BRANCH) $pfa_literal_exit "
10137 " HERE >R X-COMPILE FORTH:(LITPFA) , "
10138 " R> COMPILER:(AFTER-COMPILE-LIT) "
10139 "$pfa_literal_exit: "
10142 ufoInterpretLine("!: IMM-LITERAL LITERAL ;");
10143 ufoInterpretLine("!: IMM-CFALITERAL CFALITERAL ;");
10144 ufoInterpretLine("!: IMM-PFALITERAL PFALITERAL ;");
10148 //==========================================================================
10150 // ufoInitHandleWords
10152 //==========================================================================
10153 UFO_DISABLE_INLINE
void ufoInitHandleWords (void) {
10154 // create "HANDLE" vocabulary
10155 const uint32_t handleVocId
= ufoCreateVoc("HANDLE", 0, UFW_FLAG_PROTECTED
);
10156 ufoVocSetOnlyDefs(handleVocId
);
10157 UFWORDX("NEW", PAR_NEW_HANDLE
);
10158 UFWORDX("FREE", PAR_FREE_HANDLE
);
10159 UFWORDX("TYPEID@", PAR_HANDLE_GET_TYPEID
);
10160 UFWORDX("TYPEID!", PAR_HANDLE_SET_TYPEID
);
10161 UFWORDX("SIZE@", PAR_HANDLE_GET_SIZE
);
10162 UFWORDX("SIZE!", PAR_HANDLE_SET_SIZE
);
10163 UFWORDX("USED@", PAR_HANDLE_GET_USED
);
10164 UFWORDX("USED!", PAR_HANDLE_SET_USED
);
10165 UFWORDX("C@", PAR_HANDLE_LOAD_BYTE
);
10166 UFWORDX("W@", PAR_HANDLE_LOAD_WORD
);
10167 UFWORDX("@", PAR_HANDLE_LOAD_CELL
);
10168 UFWORDX("C!", PAR_HANDLE_STORE_BYTE
);
10169 UFWORDX("W!", PAR_HANDLE_STORE_WORD
);
10170 UFWORDX("!", PAR_HANDLE_STORE_CELL
);
10171 UFWORDX("LOAD-FILE", PAR_HANDLE_LOAD_FILE
);
10172 ufoVocSetOnlyDefs(ufoForthVocId
);
10176 //==========================================================================
10178 // ufoInitHigherWords
10180 //==========================================================================
10181 UFO_DISABLE_INLINE
void ufoInitHigherWords (void) {
10182 UFWORDX("(INCLUDE)", PAR_INCLUDE
);
10183 UFWORDX("(INCLUDE-DROP)", PAR_INCLUDE_DROP
);
10184 UFWORDX("(INCLUDE-BUILD-NAME)", PAR_INCLUDE_BUILD_NAME
);
10185 UFWORDX("(INCLUDE-NO-REFILL)", PAR_INCLUDE_NO_REFILL
);
10186 UFWORDX("(INCLUDE-LINE-SEEK)", PAR_INCLUDE_LINE_SEEK
);
10188 UFWORDX("(INCLUDE-LINE-FOFS)", PAR_INCLUDE_LINE_FOFS
);
10189 UFWORDX("(INCLUDE-DEPTH)", PAR_INCLUDE_DEPTH
);
10190 UFWORDX("(INCLUDE-FILE-ID)", PAR_INCLUDE_FILE_ID
);
10191 UFWORDX("(INCLUDE-FILE-LINE)", PAR_INCLUDE_FILE_LINE
);
10192 UFWORDX("(INCLUDE-FILE-NAME)", PAR_INCLUDE_FILE_NAME
);
10194 UFWORDX("($DEFINED?)", PAR_DLR_DEFINEDQ
);
10195 UFWORDX("($DEFINE)", PAR_DLR_DEFINE
);
10196 UFWORDX("($UNDEF)", PAR_DLR_UNDEF
);
10198 UFWORDX_IMM("$INCLUDE", DLR_INCLUDE_IMM
);
10199 UFWORDX_IMM("$INCLUDE-ONCE", DLR_INCLUDE_ONCE_IMM
);
10203 //==========================================================================
10205 // ufoInitStringWords
10207 //==========================================================================
10208 UFO_DISABLE_INLINE
void ufoInitStringWords (void) {
10209 // create "STRING" vocabulary
10210 const uint32_t stringVocId
= ufoCreateVoc("STRING", 0, UFW_FLAG_PROTECTED
);
10211 ufoVocSetOnlyDefs(stringVocId
);
10212 UFWORDX("=", STREQU
);
10213 UFWORDX("=CI", STREQUCI
);
10214 UFWORDX("SEARCH", SEARCH
);
10215 UFWORDX("HASH", STRHASH
);
10216 UFWORDX("HASH-CI", STRHASHCI
);
10217 UFWORDX("CHAR-UPPER", CHAR_UPPER
);
10218 UFWORDX("CHAR-LOWER", CHAR_LOWER
);
10219 UFWORDX("UPPER", STRUPPER
);
10220 UFWORDX("LOWER", STRLOWER
);
10221 UFWORDX("(CHAR-DIGIT)", CHAR_DIGIT
);
10222 UFWORDX("DIGIT", DIGIT
);
10223 UFWORDX("DIGIT?", DIGITQ
);
10225 UFWORDX("IS-DIGIT", IS_DIGIT
);
10226 UFWORDX("IS-BIN-DIGIT", IS_BIN_DIGIT
);
10227 UFWORDX("IS-OCT-DIGIT", IS_OCT_DIGIT
);
10228 UFWORDX("IS-HEX-DIGIT", IS_HEX_DIGIT
);
10229 UFWORDX("IS-ALPHA", IS_ALPHA
);
10230 UFWORDX("IS-UNDER-DOT", IS_UNDER_DOT
);
10231 UFWORDX("IS-ALNUM", IS_ALNUM
);
10232 UFWORDX("IS-ID-START", IS_ID_START
);
10233 UFWORDX("IS-ID-CHAR", IS_ID_CHAR
);
10235 ufoVocSetOnlyDefs(ufoForthVocId
);
10239 //==========================================================================
10241 // ufoInitDebugWords
10243 //==========================================================================
10244 UFO_DISABLE_INLINE
void ufoInitDebugWords (void) {
10245 // create "DEBUG" vocabulary
10246 const uint32_t debugVocId
= ufoCreateVoc("DEBUG", 0, UFW_FLAG_PROTECTED
);
10247 ufoVocSetOnlyDefs(debugVocId
);
10248 UFWORDX("(DECOMPILE-CFA)", DEBUG_DECOMPILE_CFA
);
10249 UFWORDX("(DECOMPILE-MEM)", DEBUG_DECOMPILE_MEM
);
10250 UFWORDX("BACKTRACE", UFO_BACKTRACE
);
10251 UFWORDX("DUMP-STACK", DUMP_STACK
);
10252 #ifdef UFO_MTASK_ALLOWED
10253 UFWORDX("BACKTRACE-TASK", UFO_BACKTRACE_TASK
);
10254 UFWORDX("DUMP-STACK-TASK", DUMP_STACK_TASK
);
10255 UFWORDX("DUMP-RSTACK-TASK", DUMP_RSTACK_TASK
);
10257 UFWORDX("(BP)", MT_DEBUGGER_BP
);
10258 UFWORDX("IP->NFA", IP2NFA
);
10259 UFWORDX("IP->FILE/LINE", IP2FILELINE
);
10260 UFWORDX("IP->FILE-HASH/LINE", IP2FILEHASHLINE
);
10261 #ifdef UFO_MTASK_ALLOWED
10262 UFWORDX("SINGLE-STEP@", DBG_GET_SS
);
10264 ufoVocSetOnlyDefs(ufoForthVocId
);
10268 //==========================================================================
10272 //==========================================================================
10273 UFO_DISABLE_INLINE
void ufoInitMTWords (void) {
10274 // create "MTASK" vocabulary
10275 const uint32_t mtVocId
= ufoCreateVoc("MTASK", 0, UFW_FLAG_PROTECTED
);
10276 ufoVocSetOnlyDefs(mtVocId
);
10277 #ifdef UFO_MTASK_ALLOWED
10278 UFWORDX("NEW-STATE", MT_NEW_STATE
);
10279 UFWORDX("FREE-STATE", MT_FREE_STATE
);
10281 UFWORDX("STATE-NAME@", MT_GET_STATE_NAME
);
10282 UFWORDX("STATE-NAME!", MT_SET_STATE_NAME
);
10283 #ifdef UFO_MTASK_ALLOWED
10284 UFWORDX("STATE-FIRST", MT_STATE_FIRST
);
10285 UFWORDX("STATE-NEXT", MT_STATE_NEXT
);
10286 UFWORDX("YIELD-TO", MT_YIELD_TO
);
10287 UFWORDX("SET-SELF-AS-DEBUGGER", MT_SET_SELF_AS_DEBUGGER
);
10288 UFWORDX("DEBUGGER-RESUME", MT_RESUME_DEBUGEE
);
10289 UFWORDX("DEBUGGER-SINGLE-STEP", MT_SINGLE_STEP_DEBUGEE
);
10291 UFWORDX("ACTIVE-STATE", MT_ACTIVE_STATE
);
10292 UFWORDX("STATE-IP@", MT_STATE_IP_GET
);
10293 UFWORDX("STATE-IP!", MT_STATE_IP_SET
);
10294 UFWORDX("STATE-A>", MT_STATE_REGA_GET
);
10295 UFWORDX("STATE->A", MT_STATE_REGA_SET
);
10296 UFWORDX("STATE-USER@", MT_STATE_USER_GET
);
10297 UFWORDX("STATE-USER!", MT_STATE_USER_SET
);
10298 UFWORDX("YIELDED-FROM", MT_YIELDED_FROM
);
10299 UFWORDX("STATE-SP@", MT_DSTACK_DEPTH_GET
);
10300 UFWORDX("STATE-RP@", MT_RSTACK_DEPTH_GET
);
10301 UFWORDX("STATE-LP@", MT_LP_GET
);
10302 UFWORDX("STATE-LBP@", MT_LBP_GET
);
10303 UFWORDX("STATE-SP!", MT_DSTACK_DEPTH_SET
);
10304 UFWORDX("STATE-RP!", MT_RSTACK_DEPTH_SET
);
10305 UFWORDX("STATE-LP!", MT_LP_SET
);
10306 UFWORDX("STATE-LBP!", MT_LBP_SET
);
10307 UFWORDX("STATE-DS@", MT_DSTACK_LOAD
);
10308 UFWORDX("STATE-RS@", MT_RSTACK_LOAD
);
10309 UFWORDX("STATE-LS@", MT_LSTACK_LOAD
);
10310 UFWORDX("STATE-DS!", MT_DSTACK_STORE
);
10311 UFWORDX("STATE-RS!", MT_RSTACK_STORE
);
10312 UFWORDX("STATE-LS!", MT_LSTACK_STORE
);
10313 UFWORDX("STATE-VSP@", MT_VSP_GET
);
10314 UFWORDX("STATE-VSP!", MT_VSP_SET
);
10315 UFWORDX("STATE-VSP-AT@", MT_VSP_LOAD
);
10316 UFWORDX("STATE-VSP-AT!", MT_VSP_STORE
);
10317 ufoVocSetOnlyDefs(ufoForthVocId
);
10321 //==========================================================================
10325 //==========================================================================
10326 UFO_DISABLE_INLINE
void ufoInitTTYWords (void) {
10327 // create "TTY" vocabulary
10328 const uint32_t ttyVocId
= ufoCreateVoc("TTY", 0, UFW_FLAG_PROTECTED
);
10329 ufoVocSetOnlyDefs(ttyVocId
);
10330 UFWORDX("TTY?", TTY_TTYQ
);
10331 UFWORDX("RAW?", TTY_RAWQ
);
10332 UFWORDX("SIZE", TTY_SIZE
);
10333 UFWORDX("SET-RAW", TTY_SET_RAW
);
10334 UFWORDX("SET-COOKED", TTY_SET_COOKED
);
10335 UFWORDX("RAW-EMIT", TTY_RAW_EMIT
);
10336 UFWORDX("RAW-TYPE", TTY_RAW_TYPE
);
10337 UFWORDX("RAW-FLUSH", TTY_RAW_FLUSH
);
10338 UFWORDX("RAW-READCH", TTY_RAW_READCH
);
10339 UFWORDX("RAW-READY?", TTY_RAW_READYQ
);
10340 ufoVocSetOnlyDefs(ufoForthVocId
);
10344 //==========================================================================
10346 // ufoInitFilesWords
10348 //==========================================================================
10349 UFO_DISABLE_INLINE
void ufoInitFilesWords (void) {
10350 // create "FILES" vocabulary
10351 const uint32_t filesVocId
= ufoCreateVoc("FILES", 0, UFW_FLAG_PROTECTED
);
10352 ufoVocSetOnlyDefs(filesVocId
);
10353 ufoDefineConstant("SEEK-SET", SEEK_SET
);
10354 ufoDefineConstant("SEEK-CUR", SEEK_CUR
);
10355 ufoDefineConstant("SEEK-END", SEEK_END
);
10357 UFWORDX("OPEN-R/O", FILES_OPEN_RO
);
10358 UFWORDX("OPEN-R/W", FILES_OPEN_RW
);
10359 UFWORDX("CREATE", FILES_CREATE
);
10360 UFWORDX("CLOSE", FILES_CLOSE
);
10361 UFWORDX("TELL", FILES_TELL
);
10362 UFWORDX("SEEK-EX", FILES_SEEK_EX
);
10363 UFWORDX("SIZE", FILES_SIZE
);
10364 UFWORDX("READ", FILES_READ
);
10365 UFWORDX("READ-EXACT", FILES_READ_EXACT
);
10366 UFWORDX("WRITE", FILES_WRITE
);
10368 UFWORDX("UNLINK", FILES_UNLINK
);
10370 UFWORDX("ERRNO", FILES_ERRNO
);
10373 ": SEEK ( ofs handle -- success? ) "
10374 " SEEK-SET FORTH:SWAP SEEK-EX "
10377 ufoVocSetOnlyDefs(ufoForthVocId
);
10381 //==========================================================================
10383 // ufoInitVeryVeryHighWords
10385 //==========================================================================
10386 UFO_DISABLE_INLINE
void ufoInitVeryVeryHighWords (void) {
10388 //ufoDefineDefer("INTERPRET", idumbCFA);
10390 ufoDefineEmitType();
10392 // ( addr count FALSE -- addr count FALSE / TRUE )
10393 ufoDefineSColonForth("(INTERPRET-CHECK-WORD)");
10395 // ( addr count FALSE -- addr count FALSE / TRUE )
10396 ufoDefineSColonForth("(INTERPRET-WORD-NOT-FOUND)");
10398 // ( addr count -- addr count )
10399 ufoDefineSColonForth("(INTERPRET-WORD-NOT-FOUND-POST)");
10401 // ( -- ) -- called in "EXIT", before compiling "FORTH:(EXIT)"
10402 ufoDefineSColonForth("(EXIT-EXTENDER)");
10408 " COMPILER:?COMP (EXIT-EXTENDER) "
10410 " COMPILE FORTH:(EXIT) "
10411 //" R> COMPILER:(AFTER-COMPILE-WORD) "
10414 ufoDefineInterpret();
10416 //ufoDumpVocab(ufoCompilerVocId);
10419 ": RUN-INTERPRET-LOOP "
10420 "$run-interp-loop-again: "
10421 " RP0! INTERPRET (UFO-INTERPRET-FINISHED-ACTION) "
10422 " FORTH:(BRANCH) $run-interp-loop-again "
10423 ";"); ufoSetLatestFlags(UFW_FLAG_NORETURN
);
10426 #define UFO_ADD_DO_CFA(cfx_) do { \
10427 ufoDo##cfx_##CFA = ufoCFAsUsed | UFO_ADDR_CFA_BIT; \
10428 ufoForthCFAs[ufoCFAsUsed] = &ufoDo##cfx_; \
10429 ufoCFAsUsed += 1; \
10433 //==========================================================================
10437 //==========================================================================
10438 static void ufoBadCFA (uint32_t pfa
) {
10439 ufoFatal("tried to execute an invalid CFA: IP=%u", ufoIP
- 4u);
10443 //==========================================================================
10447 //==========================================================================
10448 UFO_DISABLE_INLINE
void ufoInitCommon (void) {
10450 ufoForthVocId
= 0; ufoCompilerVocId
= 0;
10452 //ufoForthCFAs = calloc(UFO_MAX_NATIVE_CFAS, sizeof(ufoForthCFAs[0]));
10453 for (uint32_t f
= 0; f
< UFO_MAX_NATIVE_CFAS
; f
+= 1) ufoForthCFAs
[f
] = &ufoBadCFA
;
10455 // allocate default TIB handle
10456 //UfoHandle *tibh = ufoAllocHandle(0x69a029a6); // arbitrary number
10457 //ufoDefTIB = tibh->ufoHandle;
10459 /*ufoForthCFAs[0] = NULL;*/ ufoCFAsUsed
= 1u;
10460 UFO_ADD_DO_CFA(Forth
);
10461 UFO_ADD_DO_CFA(Variable
);
10462 UFO_ADD_DO_CFA(Value
);
10463 UFO_ADD_DO_CFA(Const
);
10464 UFO_ADD_DO_CFA(Defer
);
10465 UFO_ADD_DO_CFA(Does
);
10466 UFO_ADD_DO_CFA(Redirect
);
10467 UFO_ADD_DO_CFA(Voc
);
10468 UFO_ADD_DO_CFA(Create
);
10469 UFO_ADD_DO_CFA(UserVariable
);
10471 //fprintf(stderr, "DO-FORTH-CFA: 0x%08x\n", ufoDoForthCFA);
10475 // create "FORTH" vocabulary (it should be the first one)
10476 ufoForthVocId
= ufoCreateVoc("FORTH", 0, UFW_FLAG_PROTECTED
);
10477 ufoVocSetOnlyDefs(ufoForthVocId
);
10479 // base low-level interpreter words
10480 ufoInitBasicWords();
10482 // more FORTH words
10483 ufoInitMoreWords();
10485 // some COMPILER words
10486 ufoInitBasicCompilerWords();
10488 // STRING vocabulary
10489 ufoInitStringWords();
10491 // DEBUG vocabulary
10492 ufoInitDebugWords();
10494 // MTASK vocabulary
10497 // HANDLE vocabulary
10498 ufoInitHandleWords();
10503 // FILES vocabulary
10504 ufoInitFilesWords();
10506 // some higher-level FORTH words (includes, etc.)
10507 ufoInitHigherWords();
10509 // very-very high-level FORTH words
10510 ufoInitVeryVeryHighWords();
10512 ufoFinalLabelCheck();
10515 ufoDecompileWord(ufoFindWordChecked("RUN-INTERPRET-LOOP"));
10524 // ////////////////////////////////////////////////////////////////////////// //
10525 // virtual machine executor
10529 //==========================================================================
10533 // address interpreter
10535 //==========================================================================
10536 static void ufoRunVMxxx (uint32_t cfa
) {
10538 // VM execution loop
10540 cfa
= ufoImgGetU32(ufoIP
); ufoIP
+= 4u;
10546 //==========================================================================
10550 //==========================================================================
10551 static void ufoRunVMCFA (uint32_t cfa
) {
10552 if (ufoInRunWord
) ufoFatal("cannot run VM recursively");
10554 if (setjmp(ufoStopVMJP
) == 0) {
10561 // ////////////////////////////////////////////////////////////////////////// //
10565 //==========================================================================
10569 // register new word
10571 //==========================================================================
10572 uint32_t ufoRegisterWord (const char *wname
, ufoNativeCFA cfa
, uint32_t flags
) {
10573 ufo_assert(cfa
!= NULL
);
10574 ufo_assert(wname
!= NULL
&& wname
[0] != 0);
10575 uint32_t cfaidx
= ufoCFAsUsed
;
10576 if (cfaidx
>= UFO_MAX_NATIVE_CFAS
) ufoFatal("too many native words");
10577 ufoForthCFAs
[cfaidx
] = cfa
;
10579 //ufoDefineNative(wname, xcfa, 0);
10580 cfaidx
|= UFO_ADDR_CFA_BIT
;
10581 flags
&= 0xffffff00u
;
10582 ufoCreateWordHeader(wname
, flags
);
10583 const uint32_t res
= UFO_GET_DP();
10584 ufoImgEmitCFA(cfaidx
);
10589 //==========================================================================
10591 // ufoRegisterDataWord
10593 //==========================================================================
10594 static uint32_t ufoRegisterDataWord (const char *wname
, uint32_t cfaidx
, uint32_t value
,
10597 ufo_assert(wname
!= NULL
&& wname
[0] != 0);
10598 flags
&= 0xffffff00u
;
10599 ufoCreateWordHeader(wname
, flags
);
10600 ufoImgEmitCFA(cfaidx
);
10601 const uint32_t res
= UFO_GET_DP();
10602 ufoImgEmitU32(value
);
10607 //==========================================================================
10609 // ufoRegisterConstant
10611 //==========================================================================
10612 void ufoRegisterConstant (const char *wname
, uint32_t value
, uint32_t flags
) {
10613 (void)ufoRegisterDataWord(wname
, ufoDoConstCFA
, value
, flags
);
10617 //==========================================================================
10619 // ufoRegisterVariable
10621 //==========================================================================
10622 uint32_t ufoRegisterVariable (const char *wname
, uint32_t value
, uint32_t flags
) {
10623 return ufoRegisterDataWord(wname
, ufoDoVariableCFA
, value
, flags
);
10627 //==========================================================================
10629 // ufoRegisterValue
10631 //==========================================================================
10632 uint32_t ufoRegisterValue (const char *wname
, uint32_t value
, uint32_t flags
) {
10633 return ufoRegisterDataWord(wname
, ufoDoValueCFA
, value
, flags
);
10637 //==========================================================================
10639 // ufoRegisterDefer
10641 //==========================================================================
10642 uint32_t ufoRegisterDefer (const char *wname
, uint32_t value
, uint32_t flags
) {
10643 return ufoRegisterDataWord(wname
, ufoDoDeferCFA
, value
, flags
);
10647 //==========================================================================
10649 // ufoFindWordInVocabulary
10651 // check if we have the corresponding word.
10652 // return CFA suitable for executing, or 0.
10654 //==========================================================================
10655 uint32_t ufoFindWordInVocabulary (const char *wname
, uint32_t vocid
) {
10656 if (wname
== NULL
|| wname
[0] == 0) return 0;
10657 size_t wlen
= strlen(wname
);
10658 if (wlen
>= UFO_MAX_WORD_LENGTH
) return 0;
10659 return ufoFindWordInVocAndParents(wname
, (uint32_t)wlen
, 0, vocid
, 0);
10663 //==========================================================================
10667 //==========================================================================
10668 uint32_t ufoGetIP (void) {
10673 //==========================================================================
10677 //==========================================================================
10678 void ufoSetIP (uint32_t newip
) {
10683 //==========================================================================
10687 //==========================================================================
10688 int ufoIsExecuting (void) {
10689 return (ufoImgGetU32(ufoAddrSTATE
) == 0);
10693 //==========================================================================
10697 //==========================================================================
10698 int ufoIsCompiling (void) {
10699 return (ufoImgGetU32(ufoAddrSTATE
) != 0);
10703 //==========================================================================
10707 //==========================================================================
10708 void ufoSetExecuting (void) {
10709 ufoImgPutU32(ufoAddrSTATE
, 0);
10713 //==========================================================================
10717 //==========================================================================
10718 void ufoSetCompiling (void) {
10719 ufoImgPutU32(ufoAddrSTATE
, 1);
10723 //==========================================================================
10727 //==========================================================================
10728 uint32_t ufoGetHere () {
10729 return UFO_GET_DP();
10733 //==========================================================================
10737 //==========================================================================
10738 uint32_t ufoGetPad () {
10739 return UFO_PAD_ADDR
;
10743 //==========================================================================
10747 //==========================================================================
10748 uint8_t ufoTIBPeekCh (uint32_t ofs
) {
10749 return ufoTibPeekChOfs(ofs
);
10753 //==========================================================================
10757 //==========================================================================
10758 uint8_t ufoTIBGetCh (void) {
10759 return ufoTibGetCh();
10763 //==========================================================================
10767 //==========================================================================
10768 void ufoTIBSkipCh (void) {
10773 //==========================================================================
10777 // returns 0 on EOF
10779 //==========================================================================
10780 int ufoTIBSRefill (int allowCrossIncludes
) {
10781 return ufoLoadNextLine(allowCrossIncludes
);
10785 //==========================================================================
10789 //==========================================================================
10790 uint32_t ufoPeekData (void) {
10795 //==========================================================================
10799 //==========================================================================
10800 uint32_t ufoPopData (void) {
10805 //==========================================================================
10809 //==========================================================================
10810 void ufoPushData (uint32_t value
) {
10811 return ufoPush(value
);
10815 //==========================================================================
10819 //==========================================================================
10820 void ufoPushBoolData (int val
) {
10825 //==========================================================================
10829 //==========================================================================
10830 uint32_t ufoPeekRet (void) {
10835 //==========================================================================
10839 //==========================================================================
10840 uint32_t ufoPopRet (void) {
10845 //==========================================================================
10849 //==========================================================================
10850 void ufoPushRet (uint32_t value
) {
10851 return ufoRPush(value
);
10855 //==========================================================================
10859 //==========================================================================
10860 void ufoPushBoolRet (int val
) {
10861 ufoRPush(val
? ufoTrueValue
: 0);
10865 //==========================================================================
10869 //==========================================================================
10870 uint8_t ufoPeekByte (uint32_t addr
) {
10871 return ufoImgGetU8(addr
);
10875 //==========================================================================
10879 //==========================================================================
10880 uint16_t ufoPeekWord (uint32_t addr
) {
10887 //==========================================================================
10891 //==========================================================================
10892 uint32_t ufoPeekCell (uint32_t addr
) {
10899 //==========================================================================
10903 //==========================================================================
10904 void ufoPokeByte (uint32_t addr
, uint32_t value
) {
10905 ufoImgPutU8(addr
, value
);
10909 //==========================================================================
10913 //==========================================================================
10914 void ufoPokeWord (uint32_t addr
, uint32_t value
) {
10921 //==========================================================================
10925 //==========================================================================
10926 void ufoPokeCell (uint32_t addr
, uint32_t value
) {
10933 //==========================================================================
10937 //==========================================================================
10938 uint32_t ufoGetPAD (void) {
10939 return UFO_PAD_ADDR
;
10943 //==========================================================================
10947 //==========================================================================
10948 void ufoEmitByte (uint32_t value
) {
10949 ufoImgEmitU8(value
);
10953 //==========================================================================
10957 //==========================================================================
10958 void ufoEmitWord (uint32_t value
) {
10959 ufoImgEmitU8(value
& 0xff);
10960 ufoImgEmitU8((value
>> 8) & 0xff);
10964 //==========================================================================
10968 //==========================================================================
10969 void ufoEmitCell (uint32_t value
) {
10970 ufoImgEmitU32(value
);
10974 //==========================================================================
10978 //==========================================================================
10979 int ufoIsInited (void) {
10980 return (ufoMode
!= UFO_MODE_NONE
);
10984 //==========================================================================
10988 //==========================================================================
10989 void ufoSetUserAbort (void) {
10991 //HACK: push "(USER-ABORT)" word to RP
10992 ufoRPush(ufoUserAbortCFA
);
10996 static void (*ufoUserPostInitCB
) (void);
10999 //==========================================================================
11001 // ufoSetUserPostInit
11003 // called after main initialisation
11005 //==========================================================================
11006 void ufoSetUserPostInit (void (*cb
) (void)) {
11007 ufoUserPostInitCB
= cb
;
11011 //==========================================================================
11015 //==========================================================================
11016 int ufoSStepAllowed (void) {
11017 #ifdef UFO_MTASK_ALLOWED
11018 return (ufoSingleStepAllowed
!= 0);
11025 //==========================================================================
11027 // ufoSetSStepAllowed
11029 //==========================================================================
11030 void ufoSetSStepAllowed (int enabled
) {
11031 #ifdef UFO_MTASK_ALLOWED
11032 ufoSingleStepAllowed
= (enabled
? 1 : 0);
11039 //==========================================================================
11043 //==========================================================================
11044 void ufoInit (void) {
11045 if (ufoMode
!= UFO_MODE_NONE
) return;
11046 ufoMode
= UFO_MODE_NATIVE
;
11048 #ifdef UFO_HUGE_IMAGES
11049 memset(ufoImage
, 0, sizeof(ufoImage
));
11052 #ifdef UFO_MTASK_ALLOWED
11053 ufoSingleStepAllowed
= 0;
11057 ufoInFileName
= NULL
; ufoInFileNameLen
= 0; ufoInFileNameHash
= 0;
11059 ufoLastIncPath
= NULL
; ufoLastSysIncPath
= NULL
;
11061 #ifdef UFO_MTASK_ALLOWED
11062 for (uint32_t f
= 0; f
< UFO_MAX_STATES
; f
+= 1u) ufoStateMap
[f
] = NULL
;
11063 memset(ufoStateUsedBitmap
, 0, sizeof(ufoStateUsedBitmap
));
11064 ufoCurrState
= ufoNewState();
11065 strcpy(ufoCurrState
->name
, "MAIN");
11066 ufoInitStateUserVars(ufoCurrState
);
11068 memset(&ufoCurrState
, 0, sizeof(ufoCurrState
));
11069 strcpy(ufoCurrState
.name
, "MAIN");
11070 ufoInitStateUserVars(&ufoCurrState
);
11073 ufoImgPutU32(ufoAddrDefTIB
, 0); // create TIB handle
11074 ufoImgPutU32(ufoAddrTIBx
, 0); // create TIB handle
11076 #ifdef UFO_MTASK_ALLOWED
11077 ufoYieldedState
= NULL
;
11078 ufoDebuggerState
= NULL
;
11082 #ifdef UFO_DEBUG_STARTUP_TIMES
11083 uint32_t stt
= ufo_get_msecs();
11084 ufoCondDefine("UFO-DEBUG-STARTUP-TIMES");
11087 #ifdef UFO_DEBUG_STARTUP_TIMES
11088 uint32_t ett
= ufo_get_msecs();
11089 fprintf(stderr
, "UrForth init time: %u msecs\n", (unsigned)(ett
- stt
));
11094 if (ufoUserPostInitCB
) {
11095 ufoUserPostInitCB();
11099 // load ufo modules
11100 char *ufmname
= ufoCreateIncludeName("init", 1, NULL
);
11102 FILE *ufl
= fopen(ufmname
, "rb");
11104 FILE *ufl
= fopen(ufmname
, "r");
11108 ufoSetInFileNameReuse(ufmname
);
11110 ufoFileId
= ufoLastUsedFileId
;
11111 setLastIncPath(ufoInFileName
, 1);
11114 ufoFatal("cannot load init code");
11117 if (ufoInFile
!= NULL
) {
11118 ufoRunInterpretLoop();
11123 //==========================================================================
11127 //==========================================================================
11128 void ufoFinishVM (void) {
11129 if (ufoInRunWord
) {
11130 longjmp(ufoStopVMJP
, 669);
11132 ufoFatal("VM is not running");
11137 //==========================================================================
11139 // ufoCallParseIntr
11141 // ( -- addr count TRUE / FALSE )
11142 // does base TIB parsing; never copies anything.
11143 // as our reader is line-based, returns FALSE on EOL.
11144 // EOL is detected after skipping leading delimiters.
11145 // passing -1 as delimiter skips the whole line, and always returns FALSE.
11146 // trailing delimiter is always skipped.
11147 // result is on the data stack.
11149 //==========================================================================
11150 void ufoCallParseIntr (uint32_t delim
, int skipLeading
) {
11151 ufoPush(delim
); ufoPushBool(skipLeading
);
11156 //==========================================================================
11158 // ufoCallParseName
11160 // ( -- addr count )
11161 // parse with leading blanks skipping. doesn't copy anything.
11162 // return empty string on EOL.
11164 //==========================================================================
11165 void ufoCallParseName (void) {
11166 UFCALL(PARSE_NAME
);
11170 //==========================================================================
11174 // ( -- addr count TRUE / FALSE )
11175 // parse without skipping delimiters; never copies anything.
11176 // as our reader is line-based, returns FALSE on EOL.
11177 // passing 0 as delimiter skips the whole line, and always returns FALSE.
11178 // trailing delimiter is always skipped.
11180 //==========================================================================
11181 void ufoCallParse (uint32_t delim
) {
11187 //==========================================================================
11189 // ufoCallParseSkipBlanks
11191 //==========================================================================
11192 void ufoCallParseSkipBlanks (void) {
11193 UFCALL(PARSE_SKIP_BLANKS
);
11197 //==========================================================================
11199 // ufoCallParseSkipComments
11201 //==========================================================================
11202 void ufoCallParseSkipComments (void) {
11203 ufoPushBool(1); UFCALL(PAR_PARSE_SKIP_COMMENTS
);
11207 //==========================================================================
11209 // ufoCallParseSkipLineComments
11211 //==========================================================================
11212 void ufoCallParseSkipLineComments (void) {
11213 ufoPushBool(0); UFCALL(PAR_PARSE_SKIP_COMMENTS
);
11217 //==========================================================================
11219 // ufoCallParseSkipLine
11221 // to the end of line; doesn't refill
11223 //==========================================================================
11224 void ufoCallParseSkipLine (void) {
11225 UFCALL(PARSE_SKIP_LINE
);
11229 //==========================================================================
11231 // ufoCallBasedNumber
11233 // convert number from addrl+1
11234 // returns address of the first inconvertible char
11235 // (BASED-NUMBER) ( addr count allowsign? base -- num TRUE / FALSE )
11237 //==========================================================================
11238 void ufoCallBasedNumber (uint32_t addr
, uint32_t count
, int allowSign
, int base
) {
11239 ufoPush(addr
); ufoPush(count
); ufoPushBool(allowSign
);
11240 if (base
< 0) ufoPush(0); else ufoPush((uint32_t)base
);
11241 UFCALL(PAR_BASED_NUMBER
);
11245 //==========================================================================
11249 //==========================================================================
11250 void ufoRunWord (uint32_t cfa
) {
11252 if (ufoMode
== UFO_MODE_NONE
) ufoFatal("UrForth is not properly inited");
11253 if (ufoInRunWord
) ufoFatal("`ufoRunWord` cannot be called recursively");
11254 ufoMode
= UFO_MODE_NATIVE
;
11260 //==========================================================================
11264 //==========================================================================
11265 void ufoRunMacroWord (uint32_t cfa
) {
11267 if (ufoMode
== UFO_MODE_NONE
) ufoFatal("UrForth is not properly inited");
11268 if (ufoInRunWord
) ufoFatal("`ufoRunWord` cannot be called recursively");
11269 ufoMode
= UFO_MODE_MACRO
;
11270 const uint32_t oisp
= ufoFileStackPos
;
11273 (void)ufoLoadNextUserLine();
11276 ufo_assert(ufoFileStackPos
== oisp
); // sanity check
11281 //==========================================================================
11283 // ufoIsInMacroMode
11285 // check if we are currently in "MACRO" mode.
11286 // should be called from registered words.
11288 //==========================================================================
11289 int ufoIsInMacroMode (void) {
11290 return (ufoMode
== UFO_MODE_MACRO
);
11294 //==========================================================================
11296 // ufoRunInterpretLoop
11298 // run default interpret loop.
11300 //==========================================================================
11301 void ufoRunInterpretLoop (void) {
11302 if (ufoMode
== UFO_MODE_NONE
) {
11305 const uint32_t cfa
= ufoFindWord("RUN-INTERPRET-LOOP");
11306 if (cfa
== 0) ufoFatal("'RUN-INTERPRET-LOOP' word not found");
11308 ufoMode
= UFO_MODE_NATIVE
;
11310 while (ufoFileStackPos
!= 0) ufoPopInFile();
11314 //==========================================================================
11318 //==========================================================================
11319 void ufoRunFile (const char *fname
) {
11320 if (ufoMode
== UFO_MODE_NONE
) {
11323 if (ufoInRunWord
) ufoFatal("`ufoRunFile` cannot be called recursively");
11324 ufoMode
= UFO_MODE_NATIVE
;
11327 char *ufmname
= ufoCreateIncludeName(fname
, 0, ".");
11329 FILE *ufl
= fopen(ufmname
, "rb");
11331 FILE *ufl
= fopen(ufmname
, "r");
11335 ufoSetInFileNameReuse(ufmname
);
11337 ufoFileId
= ufoLastUsedFileId
;
11338 setLastIncPath(ufoInFileName
, 0);
11341 ufoFatal("cannot load source file '%s'", fname
);
11343 ufoRunInterpretLoop();
11347 //==========================================================================
11349 // ufoIsMTaskEnabled
11351 // check if the system was compiled with multitasking support
11353 //==========================================================================
11354 int ufoIsMTaskEnabled (void) {
11355 #ifdef UFO_MTASK_ALLOWED