Add qemu 2.4.0

Change-Id: Ic99cbad4b61f8b127b7dc74d04576c0bcbaaf4f5
Signed-off-by: Yang Zhang <yang.z.zhang@intel.com>

1 files changed, 1966 insertions, 0 deletions

diff --git a/qemu/roms/openbios/kernel/forth.c b/qemu/roms/openbios/kernel/forth.c
new file mode 100644
index 000000000..61dd70d31
--- /dev/null
+++ b/qemu/roms/openbios/kernel/forth.c
@@ -0,0 +1,1966 @@
+/* tag: C implementation of all forth primitives,
+ * internal words, inner interpreter and such
+ *
+ * Copyright (C) 2003 Patrick Mauritz, Stefan Reinauer
+ *
+ * See the file "COPYING" for further information about
+ * the copyright and warranty status of this work.
+ */
+
+#include "config.h"
+#include "sysinclude.h"
+#include "kernel/stack.h"
+#include "kernel/kernel.h"
+#include "dict.h"
+
+/*
+ * cross platform abstraction
+ */
+
+#include "cross.h"
+
+#ifndef FCOMPILER
+#include "libc/vsprintf.h"
+#else
+#include <stdarg.h>
+#endif
+
+/*
+ * execution works as follows:
+ *  - PC is pushed on return stack
+ *  - PC is set to new CFA
+ *  - address pointed by CFA is executed by CPU
+ */
+
+typedef void forth_word(void);
+
+static forth_word * const words[];
+ucell PC;
+volatile int interruptforth = 0;
+
+#define DEBUG_MODE_NONE 0
+#define DEBUG_MODE_STEP 1
+#define DEBUG_MODE_TRACE 2
+#define DEBUG_MODE_STEPUP 3
+
+#define DEBUG_BANNER "\nStepper keys: <space>/<enter> Up Down Trace Rstack Forth\n"
+
+/* Empty linked list of debug xts */
+struct debug_xt {
+    ucell xt_docol;
+    ucell xt_semis;
+    int mode;
+    struct debug_xt *next;
+};
+
+static struct debug_xt debug_xt_eol = { (ucell)0, (ucell)0, 0, NULL};
+static struct debug_xt *debug_xt_list = &debug_xt_eol;
+
+/* Static buffer for xt name */
+char xtname[MAXNFALEN];
+
+#ifndef FCOMPILER
+/* instead of pointing to an explicit 0 variable we
+ * point behind the pointer.
+ */
+static ucell t[] = { 0, 0, 0, 0 };
+static ucell *trampoline = t;
+
+/*
+ * Code Field Address (CFA) definitions (DOCOL and the like)
+ */
+
+void forth_init(void)
+{
+    init_trampoline(trampoline);
+}
+#endif
+
+#ifndef CONFIG_DEBUG_INTERPRETER
+#define dbg_interp_printk( a... )       do { } while(0)
+#else
+#define dbg_interp_printk( a... )       printk( a )
+#endif
+
+#ifndef CONFIG_DEBUG_INTERNAL
+#define dbg_internal_printk( a... )     do { } while(0)
+#else
+#define dbg_internal_printk( a... )     printk( a )
+#endif
+
+
+void init_trampoline(ucell *tramp)
+{
+    tramp[0] = DOCOL;
+    tramp[1] = 0;
+    tramp[2] = target_ucell(pointer2cell(tramp) + 3 * sizeof(ucell));
+    tramp[3] = 0;
+}
+
+static inline void processxt(ucell xt)
+{
+    void (*tokenp) (void);
+
+    dbg_interp_printk("processxt: pc=%x, xt=%x\n", PC, xt);
+    tokenp = words[xt];
+    tokenp();
+}
+
+static void docol(void)
+{                               /* DOCOL */
+    PUSHR(PC);
+    PC = read_ucell(cell2pointer(PC));
+
+    dbg_interp_printk("docol: %s\n", cell2pointer( lfa2nfa(PC - sizeof(cell)) ));
+}
+
+static void semis(void)
+{
+    PC = POPR();
+}
+
+static inline void next(void)
+{
+    PC += sizeof(ucell);
+
+    dbg_interp_printk("next: PC is now %x\n", PC);
+    processxt(read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))));
+}
+
+static inline void next_dbg(void);
+
+int enterforth(xt_t xt)
+{
+    ucell *_cfa = (ucell*)cell2pointer(xt);
+    cell tmp;
+
+    if (read_ucell(_cfa) != DOCOL) {
+        trampoline[1] = target_ucell(xt);
+        _cfa = trampoline;
+    }
+
+    if (rstackcnt < 0) {
+        rstackcnt = 0;
+    }
+
+    tmp = rstackcnt;
+    interruptforth = FORTH_INTSTAT_CLR;
+
+    PUSHR(PC);
+    PC = pointer2cell(_cfa);
+
+    while (rstackcnt > tmp && !(interruptforth & FORTH_INTSTAT_STOP)) {
+        if (debug_xt_list->next == NULL) {
+            while (rstackcnt > tmp && !interruptforth) {
+                dbg_interp_printk("enterforth: NEXT\n");
+                next();
+            }
+        } else {
+            while (rstackcnt > tmp && !interruptforth) {
+                dbg_interp_printk("enterforth: NEXT_DBG\n");
+                next_dbg();
+            }
+        }
+
+        /* Always clear the debug mode change flag */
+        interruptforth = interruptforth & (~FORTH_INTSTAT_DBG);
+    }
+
+#if 0
+    /* return true if we took an exception. The caller should normally
+     * handle exceptions by returning immediately since the throw
+     * is supposed to abort the execution of this C-code too.
+     */
+
+    if (rstackcnt != tmp) {
+        printk("EXCEPTION DETECTED!\n");
+    }
+#endif
+    return rstackcnt != tmp;
+}
+
+/* called inline thus a slightly different behaviour */
+static void lit(void)
+{                               /* LIT */
+    PC += sizeof(cell);
+    PUSH(read_ucell(cell2pointer(PC)));
+    dbg_interp_printk("lit: %x\n", read_ucell(cell2pointer(PC)));
+}
+
+static void docon(void)
+{                               /* DOCON */
+    ucell tmp = read_ucell(cell2pointer(read_ucell(cell2pointer(PC)) + sizeof(ucell)));
+    PUSH(tmp);
+    dbg_interp_printk("docon: PC=%x, value=%x\n", PC, tmp);
+}
+
+static void dovar(void)
+{                               /* DOVAR */
+    ucell tmp = read_ucell(cell2pointer(PC)) + sizeof(ucell);
+    PUSH(tmp);              /* returns address to variable */
+    dbg_interp_printk("dovar: PC: %x, %x\n", PC, tmp);
+}
+
+static void dobranch(void)
+{                               /* unconditional branch */
+    PC += sizeof(cell);
+    PC += read_cell(cell2pointer(PC));
+}
+
+static void docbranch(void)
+{                               /* conditional branch */
+    PC += sizeof(cell);
+    if (POP()) {
+        dbg_internal_printk("  ?branch: end loop\n");
+    } else {
+        dbg_internal_printk("  ?branch: follow branch\n");
+        PC += read_cell(cell2pointer(PC));
+    }
+}
+
+
+static void execute(void)
+{                               /* EXECUTE */
+    ucell address = POP();
+    dbg_interp_printk("execute: %x\n", address);
+
+    PUSHR(PC);
+    trampoline[1] = target_ucell(address);
+    PC = pointer2cell(trampoline);
+}
+
+/*
+ * call ( ... function-ptr -- ??? )
+ */
+static void call(void)
+{
+#ifdef FCOMPILER
+    printk("Sorry. Usage of Forth2C binding is forbidden during bootstrap.\n");
+    exit(1);
+#else
+    void (*funcptr) (void);
+    funcptr=(void *)cell2pointer(POP());
+    dbg_interp_printk("call: %x", funcptr);
+    funcptr();
+#endif
+}
+
+/*
+ * sys-debug ( errno -- )
+ */
+
+static void sysdebug(void)
+{
+#ifdef FCOMPILER
+    cell errorno=POP();
+    exception(errorno);
+#else
+    (void) POP();
+#endif
+}
+
+static void dodoes(void)
+{                               /* DODOES */
+    ucell data = read_ucell(cell2pointer(PC)) + (2 * sizeof(ucell));
+    ucell word = read_ucell(cell2pointer(read_ucell(cell2pointer(PC)) + sizeof(ucell)));
+
+    dbg_interp_printk("DODOES data=%x word=%x\n", data, word);
+
+    PUSH(data);
+    PUSH(word);
+
+    execute();
+}
+
+static void dodefer(void)
+{
+    docol();
+}
+
+static void dodo(void)
+{
+    cell startval, endval;
+    startval = POP();
+    endval = POP();
+
+    PUSHR(endval);
+    PUSHR(startval);
+}
+
+static void doisdo(void)
+{
+    cell startval, endval, offset;
+
+    startval = POP();
+    endval = POP();
+
+    PC += sizeof(cell);
+
+    if (startval == endval) {
+        offset = read_cell(cell2pointer(PC));
+        PC += offset;
+    } else {
+        PUSHR(endval);
+        PUSHR(startval);
+    }
+}
+
+static void doloop(void)
+{
+    cell offset, startval, endval;
+
+    startval = POPR() + 1;
+    endval = POPR();
+
+    PC += sizeof(cell);
+
+    if (startval < endval) {
+        offset = read_cell(cell2pointer(PC));
+        PC += offset;
+        PUSHR(endval);
+        PUSHR(startval);
+    }
+
+}
+
+static void doplusloop(void)
+{
+    ucell high, low;
+    cell increment, startval, endval, offset;
+
+    increment = POP();
+
+    startval = POPR();
+    endval = POPR();
+
+    low = (ucell) startval;
+    startval += increment;
+
+    PC += sizeof(cell);
+
+    if (increment >= 0) {
+        high = (ucell) startval;
+    } else {
+        high = low;
+        low = (ucell) startval;
+    }
+
+    if (endval - (low + 1) >= high - low) {
+        offset = read_cell(cell2pointer(PC));
+        PC += offset;
+
+        PUSHR(endval);
+        PUSHR(startval);
+    }
+}
+
+/*
+ *  instance handling CFAs
+ */
+#ifndef FCOMPILER
+static ucell get_myself(void)
+{
+    static ucell *myselfptr = NULL;
+    if (myselfptr == NULL) {
+        myselfptr = (ucell*)cell2pointer(findword("my-self")) + 1;
+    }
+    ucell *myself = (ucell*)cell2pointer(*myselfptr);
+    return (myself != NULL) ? *myself : 0;
+}
+
+static void doivar(void)
+{
+    ucell r, *p = (ucell *)(*(ucell *) cell2pointer(PC) + sizeof(ucell));
+    ucell ibase = get_myself();
+
+    dbg_interp_printk("ivar, offset: %d size: %d (ibase %d)\n", p[0], p[1], ibase );
+
+    r = ibase ? ibase + p[0] : pointer2cell(&p[2]);
+    PUSH( r );
+}
+
+static void doival(void)
+{
+    ucell r, *p = (ucell *)(*(ucell *) cell2pointer(PC) + sizeof(ucell));
+    ucell ibase = get_myself();
+
+    dbg_interp_printk("ivar, offset: %d size: %d\n", p[0], p[1] );
+
+    r = ibase ? ibase + p[0] : pointer2cell(&p[2]);
+    PUSH( *(ucell *)cell2pointer(r) );
+}
+
+static void doidefer(void)
+{
+    ucell *p = (ucell *)(*(ucell *) cell2pointer(PC) + sizeof(ucell));
+    ucell ibase = get_myself();
+
+    dbg_interp_printk("doidefer, offset: %d size: %d\n", p[0], p[1] );
+
+    PUSHR(PC);
+    PC = ibase ? ibase + p[0] : pointer2cell(&p[2]);
+    PC -= sizeof(ucell);
+}
+#else
+static void noinstances(void)
+{
+    printk("Opening devices is not supported during bootstrap. Sorry.\n");
+    exit(1);
+}
+#define doivar   noinstances
+#define doival   noinstances
+#define doidefer noinstances
+#endif
+
+/*
+ * $include / $encode-file
+ */
+#ifdef FCOMPILER
+static void
+string_relay(void (*func)(const char *))
+{
+    int len = POP();
+    char *name, *p = (char*)cell2pointer(POP());
+    name = malloc(len + 1);
+    memcpy(name, p, len);
+    name[len] = 0;
+    (*func)(name);
+    free(name);
+}
+#else
+#define string_relay(dummy) do { DROP(); DROP(); } while(0)
+#endif
+
+static void
+do_include(void)
+{
+    string_relay(&include_file);
+}
+
+static void
+do_encode_file( void )
+{
+    string_relay(&encode_file);
+}
+
+/*
+ * Debug support functions
+ */
+
+static
+int printf_console(const char *fmt, ...)
+{
+    cell tmp;
+
+    char buf[512];
+    va_list args;
+    int i;
+
+    va_start(args, fmt);
+    i = vsnprintf(buf, sizeof(buf), fmt, args);
+    va_end(args);
+
+    /* Push to the Forth interpreter for console output */
+    tmp = rstackcnt;
+
+    PUSH(pointer2cell(buf));
+    PUSH((int)strlen(buf));
+    trampoline[1] = findword("type");
+
+    PUSHR(PC);
+    PC = pointer2cell(trampoline);
+
+    while (rstackcnt > tmp) {
+        dbg_interp_printk("printf_console: NEXT\n");
+        next();
+    }
+
+    return i;
+}
+
+static
+int getchar_console(void)
+{
+    cell tmp;
+
+    /* Push to the Forth interpreter for console output */
+    tmp = rstackcnt;
+
+    trampoline[1] = findword("key");
+
+    PUSHR(PC);
+    PC = pointer2cell(trampoline);
+
+    while (rstackcnt > tmp) {
+        dbg_interp_printk("getchar_console: NEXT\n");
+        next();
+    }
+
+    return POP();
+}
+
+static void
+display_dbg_dstack(void)
+{
+    /* Display dstack contents between parentheses */
+    int i;
+
+    if (dstackcnt == 0) {
+        printf_console(" ( Empty ) ");
+        return;
+    } else {
+        printf_console(" ( ");
+        for (i = 1; i <= dstackcnt; i++) {
+            if (i != 1) {
+                printf_console(" ");
+            }
+            printf_console("%" FMT_CELL_x, dstack[i]);
+        }
+        printf_console(" ) ");
+    }
+}
+
+static void
+display_dbg_rstack(void)
+{
+    /* Display rstack contents between parentheses */
+    int i;
+
+    if (rstackcnt == 0) {
+        printf_console(" ( Empty ) ");
+        return;
+    } else {
+        printf_console("\nR: ( ");
+        for (i = 1; i <= rstackcnt; i++) {
+            if (i != 1) {
+                printf_console(" ");
+            }
+            printf_console("%" FMT_CELL_x, rstack[i]);
+        }
+        printf_console(" ) \n");
+    }
+}
+
+static int
+add_debug_xt(ucell xt)
+{
+    struct debug_xt *debug_xt_item;
+
+    /* If the xt CFA isn't DOCOL then issue a warning and do nothing */
+    if (read_ucell(cell2pointer(xt)) != DOCOL) {
+        printf_console("\nprimitive words cannot be debugged\n");
+        return 0;
+    }
+
+    /* If this xt is already in the list, do nothing but indicate success */
+    for (debug_xt_item = debug_xt_list; debug_xt_item->next != NULL;
+         debug_xt_item = debug_xt_item->next)
+        if (debug_xt_item->xt_docol == xt) {
+            return 1;
+        }
+
+    /* We already have the CFA (PC) indicating the starting cell of
+       the word, however we also need the ending cell too (we cannot
+       rely on the rstack as it can be arbitrarily changed by a forth
+       word). Hence the use of findsemis() */
+
+    /* Otherwise add to the head of the linked list */
+    debug_xt_item = malloc(sizeof(struct debug_xt));
+    debug_xt_item->xt_docol = xt;
+    debug_xt_item->xt_semis = findsemis(xt);
+    debug_xt_item->mode = DEBUG_MODE_NONE;
+    debug_xt_item->next = debug_xt_list;
+    debug_xt_list = debug_xt_item;
+
+    /* Indicate debug mode change */
+    interruptforth |= FORTH_INTSTAT_DBG;
+
+    /* Success */
+    return 1;
+}
+
+static void
+del_debug_xt(ucell xt)
+{
+    struct debug_xt *debug_xt_item, *tmp_xt_item;
+
+    /* Handle the case where the xt is at the head of the list */
+    if (debug_xt_list->xt_docol == xt) {
+        tmp_xt_item = debug_xt_list;
+        debug_xt_list = debug_xt_list->next;
+        free(tmp_xt_item);
+
+        return;
+    }
+
+    /* Otherwise find this xt in the linked list and remove it */
+    for (debug_xt_item = debug_xt_list; debug_xt_item->next != NULL;
+         debug_xt_item = debug_xt_item->next) {
+        if (debug_xt_item->next->xt_docol == xt) {
+            tmp_xt_item = debug_xt_item->next;
+            debug_xt_item->next = debug_xt_item->next->next;
+            free(tmp_xt_item);
+        }
+    }
+
+    /* If the list is now empty, indicate debug mode change */
+    if (debug_xt_list->next == NULL) {
+        interruptforth |= FORTH_INTSTAT_DBG;
+    }
+}
+
+static void
+do_source_dbg(struct debug_xt *debug_xt_item)
+{
+    /* Forth source debugger implementation */
+    char k, done = 0;
+
+    /* Display current dstack */
+    display_dbg_dstack();
+    printf_console("\n");
+
+    fstrncpy(xtname, lfa2nfa(read_ucell(cell2pointer(PC)) - sizeof(cell)), MAXNFALEN);
+    printf_console("%p: %s ", cell2pointer(PC), xtname);
+
+    /* If in trace mode, we just carry on */
+    if (debug_xt_item->mode == DEBUG_MODE_TRACE) {
+        return;
+    }
+
+    /* Otherwise in step mode, prompt for a keypress */
+    k = getchar_console();
+
+    /* Only proceed if done is true */
+    while (!done) {
+        switch (k) {
+
+        case ' ':
+        case '\n':
+            /* Perform a single step */
+            done = 1;
+            break;
+
+        case 'u':
+        case 'U':
+            /* Up - unmark current word for debug, mark its caller for
+             * debugging and finish executing current word */
+
+            /* Since this word could alter the rstack during its execution,
+             * we only know the caller when (semis) is called for this xt.
+             * Hence we mark the xt as a special DEBUG_MODE_STEPUP which
+             * means we run as normal, but schedule the xt for deletion
+             * at its corresponding (semis) word when we know the rstack
+             * will be set to its final parent value */
+            debug_xt_item->mode = DEBUG_MODE_STEPUP;
+            done = 1;
+            break;
+
+        case 'd':
+        case 'D':
+            /* Down - mark current word for debug and step into it */
+            done = add_debug_xt(read_ucell(cell2pointer(PC)));
+            if (!done) {
+                k = getchar_console();
+            }
+            break;
+
+        case 't':
+        case 'T':
+            /* Trace mode */
+            debug_xt_item->mode = DEBUG_MODE_TRACE;
+            done = 1;
+            break;
+
+        case 'r':
+        case 'R':
+            /* Display rstack */
+            display_dbg_rstack();
+            done = 0;
+            k = getchar_console();
+            break;
+
+        case 'f':
+        case 'F':
+            /* Start subordinate Forth interpreter */
+            PUSHR(PC - sizeof(cell));
+            PC = findword("outer-interpreter") + sizeof(ucell);
+
+            /* Save rstack position for when we return */
+            dbgrstackcnt = rstackcnt;
+            done = 1;
+            break;
+
+        default:
+            /* Display debug banner */
+            printf_console(DEBUG_BANNER);
+            k = getchar_console();
+        }
+    }
+}
+
+static void docol_dbg(void)
+{                               /* DOCOL */
+    struct debug_xt *debug_xt_item;
+
+    PUSHR(PC);
+    PC = read_ucell(cell2pointer(PC));
+
+    /* If current xt is in our debug xt list, display word name */
+    debug_xt_item = debug_xt_list;
+    while (debug_xt_item->next) {
+        if (debug_xt_item->xt_docol == PC) {
+            fstrncpy(xtname, lfa2nfa(PC - sizeof(cell)), MAXNFALEN);
+            printf_console("\n: %s ", xtname);
+
+            /* Step mode is the default */
+            debug_xt_item->mode = DEBUG_MODE_STEP;
+        }
+
+        debug_xt_item = debug_xt_item->next;
+    }
+
+    dbg_interp_printk("docol_dbg: %s\n", cell2pointer(lfa2nfa(PC - sizeof(cell))));
+}
+
+static void semis_dbg(void)
+{
+    struct debug_xt *debug_xt_item, *debug_xt_up = NULL;
+
+    /* If current semis is in our debug xt list, disable debug mode */
+    debug_xt_item = debug_xt_list;
+    while (debug_xt_item->next) {
+        if (debug_xt_item->xt_semis == PC) {
+            if (debug_xt_item->mode != DEBUG_MODE_STEPUP) {
+                /* Handle the normal case */
+                fstrncpy(xtname, lfa2nfa(debug_xt_item->xt_docol - sizeof(cell)), MAXNFALEN);
+                printf_console("\n[ Finished %s ] ", xtname);
+
+                /* Reset to step mode in case we were in trace mode */
+                debug_xt_item->mode = DEBUG_MODE_STEP;
+            } else {
+                /* This word requires execution of the debugger "Up"
+                 * semantics. However we can't do this here since we
+                 * are iterating through the debug list, and we need
+                 * to change it. So we do it afterwards.
+                 */
+                debug_xt_up = debug_xt_item;
+            }
+        }
+
+        debug_xt_item = debug_xt_item->next;
+    }
+
+    /* Execute debugger "Up" semantics if required */
+    if (debug_xt_up) {
+        /* Only add the parent word if it is not within the trampoline */
+        if (rstack[rstackcnt] != (cell)pointer2cell(&trampoline[1])) {
+            del_debug_xt(debug_xt_up->xt_docol);
+            add_debug_xt(findxtfromcell(rstack[rstackcnt]));
+
+            fstrncpy(xtname, lfa2nfa(findxtfromcell(rstack[rstackcnt]) - sizeof(cell)), MAXNFALEN);
+            printf_console("\n[ Up to %s ] ", xtname);
+        } else {
+            fstrncpy(xtname, lfa2nfa(findxtfromcell(debug_xt_up->xt_docol) - sizeof(cell)), MAXNFALEN);
+            printf_console("\n[ Finished %s (Unable to go up, hit trampoline) ] ", xtname);
+
+            del_debug_xt(debug_xt_up->xt_docol);
+        }
+
+        debug_xt_up = NULL;
+    }
+
+    PC = POPR();
+}
+
+static inline void next_dbg(void)
+{
+    struct debug_xt *debug_xt_item;
+    void (*tokenp) (void);
+
+    PC += sizeof(ucell);
+
+    /* If the PC lies within a debug range, run the source debugger */
+    debug_xt_item = debug_xt_list;
+    while (debug_xt_item->next) {
+        if (PC >= debug_xt_item->xt_docol && PC <= debug_xt_item->xt_semis &&
+            debug_xt_item->mode != DEBUG_MODE_STEPUP) {
+            do_source_dbg(debug_xt_item);
+        }
+
+        debug_xt_item = debug_xt_item->next;
+    }
+
+    dbg_interp_printk("next_dbg: PC is now %x\n", PC);
+
+    /* Intercept DOCOL and SEMIS and redirect to debug versions */
+    if (read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))) == DOCOL) {
+        tokenp = docol_dbg;
+        tokenp();
+    } else if (read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))) == DOSEMIS) {
+        tokenp = semis_dbg;
+        tokenp();
+    } else {
+        /* Otherwise process as normal */
+        processxt(read_ucell(cell2pointer(read_ucell(cell2pointer(PC)))));
+    }
+}
+
+static void
+do_debug_xt(void)
+{
+    ucell xt = POP();
+
+    /* Add to the debug list */
+    if (add_debug_xt(xt)) {
+        /* Display debug banner */
+        printf_console(DEBUG_BANNER);
+
+        /* Indicate change to debug mode */
+        interruptforth |= FORTH_INTSTAT_DBG;
+    }
+}
+
+static void
+do_debug_off(void)
+{
+    /* Empty the debug xt linked list */
+    while (debug_xt_list->next != NULL) {
+        del_debug_xt(debug_xt_list->xt_docol);
+    }
+}
+
+/*
+ * Forth primitives needed to set up
+ * all the words described in IEEE1275-1994.
+ */
+
+/*
+ *  dup         ( x -- x x )
+ */
+
+static void fdup(void)
+{
+	const cell tmp = GETTOS();
+	PUSH(tmp);
+}
+
+
+/*
+ *  2dup        ( x1 x2 -- x1 x2 x1 x2 )
+ */
+
+static void twodup(void)
+{
+	cell tmp = GETITEM(1);
+	PUSH(tmp);
+	tmp = GETITEM(1);
+	PUSH(tmp);
+}
+
+
+/*
+ *  ?dup        ( x -- 0 | x x )
+ */
+
+static void isdup(void)
+{
+	const cell tmp = GETTOS();
+	if (tmp)
+		PUSH(tmp);
+}
+
+
+/*
+ *  over        ( x y -- x y x )
+ */
+
+static void over(void)
+{
+	const cell tmp = GETITEM(1);
+	PUSH(tmp);
+}
+
+
+/*
+ *  2over ( x1 x2 x3 x4 -- x1 x2 x3 x4 x1 x2 )
+ */
+
+static void twoover(void)
+{
+	const cell tmp = GETITEM(3);
+	const cell tmp2 = GETITEM(2);
+	PUSH(tmp);
+	PUSH(tmp2);
+}
+
+/*
+ *  pick        ( xu ... x1 x0 u -- xu ... x1 x0 xu )
+ */
+
+static void pick(void)
+{
+	const cell u = POP();
+	if (dstackcnt >= u) {
+		ucell tmp = dstack[dstackcnt - u];
+		PUSH(tmp);
+	} else {
+		/* underrun */
+	}
+}
+
+
+/*
+ *  drop        ( x --  )
+ */
+
+static void drop(void)
+{
+	POP();
+}
+
+/*
+ *  2drop       ( x1 x2 --  )
+ */
+
+static void twodrop(void)
+{
+	POP();
+	POP();
+}
+
+
+/*
+ *  nip         ( x1 x2 -- x2 )
+ */
+
+static void nip(void)
+{
+	const cell tmp = POP();
+	POP();
+	PUSH(tmp);
+}
+
+
+/*
+ *  roll        ( xu ... x1 x0 u -- xu-1... x1 x0 xu )
+ */
+
+static void roll(void)
+{
+	const cell u = POP();
+	if (dstackcnt >= u) {
+		int i;
+		const cell xu = dstack[dstackcnt - u];
+		for (i = dstackcnt - u; i < dstackcnt; i++) {
+			dstack[i] = dstack[i + 1];
+		}
+		dstack[dstackcnt] = xu;
+	} else {
+		/* Stack underrun */
+	}
+}
+
+
+/*
+ *  rot         ( x1 x2 x3 -- x2 x3 x1 )
+ */
+
+static void rot(void)
+{
+	const cell tmp = POP();
+	const cell tmp2 = POP();
+	const cell tmp3 = POP();
+	PUSH(tmp2);
+	PUSH(tmp);
+	PUSH(tmp3);
+}
+
+
+/*
+ *  -rot        ( x1 x2 x3 -- x3 x1 x2 )
+ */
+
+static void minusrot(void)
+{
+	const cell tmp = POP();
+	const cell tmp2 = POP();
+	const cell tmp3 = POP();
+	PUSH(tmp);
+	PUSH(tmp3);
+	PUSH(tmp2);
+}
+
+
+/*
+ *  swap        ( x1 x2 -- x2 x1 )
+ */
+
+static void swap(void)
+{
+	const cell tmp = POP();
+	const cell tmp2 = POP();
+	PUSH(tmp);
+	PUSH(tmp2);
+}
+
+
+/*
+ *  2swap       ( x1 x2 x3 x4 -- x3 x4 x1 x2 )
+ */
+
+static void twoswap(void)
+{
+	const cell tmp = POP();
+	const cell tmp2 = POP();
+	const cell tmp3 = POP();
+	const cell tmp4 = POP();
+	PUSH(tmp2);
+	PUSH(tmp);
+	PUSH(tmp4);
+	PUSH(tmp3);
+}
+
+
+/*
+ *  >r          ( x -- ) (R: -- x )
+ */
+
+static void tor(void)
+{
+	ucell tmp = POP();
+#ifdef CONFIG_DEBUG_RSTACK
+	printk("  >R: %x\n", tmp);
+#endif
+	PUSHR(tmp);
+}
+
+
+/*
+ *  r>          ( -- x ) (R: x -- )
+ */
+
+static void rto(void)
+{
+	ucell tmp = POPR();
+#ifdef CONFIG_DEBUG_RSTACK
+	printk("  R>: %x\n", tmp);
+#endif
+	PUSH(tmp);
+}
+
+
+/*
+ *  r@          ( -- x ) (R: x -- x )
+ */
+
+static void rfetch(void)
+{
+	PUSH(GETTORS());
+}
+
+
+/*
+ *  depth       (  -- u )
+ */
+
+static void depth(void)
+{
+	const cell tmp = dstackcnt;
+	PUSH(tmp);
+}
+
+
+/*
+ *  depth!      ( ... u --  x1 x2 .. xu )
+ */
+
+static void depthwrite(void)
+{
+	ucell tmp = POP();
+	dstackcnt = tmp;
+}
+
+
+/*
+ *  rdepth      (  -- u )
+ */
+
+static void rdepth(void)
+{
+	const cell tmp = rstackcnt;
+	PUSH(tmp);
+}
+
+
+/*
+ *  rdepth!     ( u --  ) ( R: ... -- x1 x2 .. xu )
+ */
+
+static void rdepthwrite(void)
+{
+	ucell tmp = POP();
+	rstackcnt = tmp;
+}
+
+
+/*
+ *  +           ( nu1 nu2 -- sum )
+ */
+
+static void plus(void)
+{
+	cell tmp = POP() + POP();
+	PUSH(tmp);
+}
+
+
+/*
+ *  -           ( nu1 nu2 -- diff )
+ */
+
+static void minus(void)
+{
+	const cell nu2 = POP();
+	const cell nu1 = POP();
+	PUSH(nu1 - nu2);
+}
+
+
+/*
+ *  *           ( nu1 nu2 -- prod )
+ */
+
+static void mult(void)
+{
+	const cell nu2 = POP();
+	const cell nu1 = POP();
+	PUSH(nu1 * nu2);
+}
+
+
+/*
+ *  u*          ( u1 u2 -- prod )
+ */
+
+static void umult(void)
+{
+	const ucell tmp = (ucell) POP() * (ucell) POP();
+	PUSH(tmp);
+}
+
+
+/*
+ *  mu/mod      ( n1 n2 -- rem quot.l quot.h )
+ */
+
+static void mudivmod(void)
+{
+	const ucell b = POP();
+	const ducell a = DPOP();
+#ifdef NEED_FAKE_INT128_T
+        if (a.hi != 0) {
+            fprintf(stderr, "mudivmod called (0x%016llx %016llx / 0x%016llx)\n",
+                    a.hi, a.lo, b);
+            exit(-1);
+        } else {
+            ducell c;
+
+            PUSH(a.lo % b);
+            c.hi = 0;
+            c.lo = a.lo / b;
+            DPUSH(c);
+        }
+#else
+	PUSH(a % b);
+	DPUSH(a / b);
+#endif
+}
+
+
+/*
+ *  abs         ( n -- u )
+ */
+
+static void forthabs(void)
+{
+	const cell tmp = GETTOS();
+	if (tmp < 0) {
+		POP();
+		PUSH(-tmp);
+	}
+}
+
+
+/*
+ *  negate      ( n1 -- n2 )
+ */
+
+static void negate(void)
+{
+	const cell tmp = POP();
+	PUSH(-tmp);
+}
+
+
+/*
+ *  max         ( n1 n2 -- n1|n2 )
+ */
+
+static void max(void)
+{
+	const cell tmp = POP();
+	const cell tmp2 = POP();
+	PUSH((tmp > tmp2) ? tmp : tmp2);
+}
+
+
+/*
+ *  min         ( n1 n2 -- n1|n2 )
+ */
+
+static void min(void)
+{
+	const cell tmp = POP();
+	const cell tmp2 = POP();
+	PUSH((tmp < tmp2) ? tmp : tmp2);
+}
+
+
+/*
+ *  lshift      ( x1 u -- x2 )
+ */
+
+static void lshift(void)
+{
+	const ucell u = POP();
+	const ucell x1 = POP();
+	PUSH(x1 << u);
+}
+
+
+/*
+ *  rshift      ( x1 u -- x2 )
+ */
+
+static void rshift(void)
+{
+	const ucell u = POP();
+	const ucell x1 = POP();
+	PUSH(x1 >> u);
+}
+
+
+/*
+ *  >>a         ( x1 u -- x2 ) ??
+ */
+
+static void rshifta(void)
+{
+	const cell u = POP();
+	const cell x1 = POP();
+	PUSH(x1 >> u);
+}
+
+
+/*
+ *  and         ( x1 x2 -- x3 )
+ */
+
+static void and(void)
+{
+	const cell x1 = POP();
+	const cell x2 = POP();
+	PUSH(x1 & x2);
+}
+
+
+/*
+ *  or          ( x1 x2 -- x3 )
+ */
+
+static void or(void)
+{
+	const cell x1 = POP();
+	const cell x2 = POP();
+	PUSH(x1 | x2);
+}
+
+
+/*
+ *  xor         ( x1 x2 -- x3 )
+ */
+
+static void xor(void)
+{
+	const cell x1 = POP();
+	const cell x2 = POP();
+	PUSH(x1 ^ x2);
+}
+
+
+/*
+ *  invert      ( x1 -- x2 )
+ */
+
+static void invert(void)
+{
+	const cell x1 = POP();
+	PUSH(x1 ^ -1);
+}
+
+
+/*
+ *  d+          ( d1 d2 -- d.sum )
+ */
+
+static void dplus(void)
+{
+	const dcell d2 = DPOP();
+	const dcell d1 = DPOP();
+#ifdef NEED_FAKE_INT128_T
+        ducell c;
+
+        if (d1.hi != 0 || d2.hi != 0) {
+            fprintf(stderr, "dplus called (0x%016llx %016llx + 0x%016llx %016llx)\n",
+                    d1.hi, d1.lo, d2.hi, d2.lo);
+            exit(-1);
+        }
+        c.hi = 0;
+        c.lo = d1.lo + d2.lo;
+        DPUSH(c);
+#else
+	DPUSH(d1 + d2);
+#endif
+}
+
+
+/*
+ *  d-          ( d1 d2 -- d.diff )
+ */
+
+static void dminus(void)
+{
+	const dcell d2 = DPOP();
+	const dcell d1 = DPOP();
+#ifdef NEED_FAKE_INT128_T
+        ducell c;
+
+        if (d1.hi != 0 || d2.hi != 0) {
+            fprintf(stderr, "dminus called (0x%016llx %016llx + 0x%016llx %016llx)\n",
+                    d1.hi, d1.lo, d2.hi, d2.lo);
+            exit(-1);
+        }
+        c.hi = 0;
+        c.lo = d1.lo - d2.lo;
+        DPUSH(c);
+#else
+	DPUSH(d1 - d2);
+#endif
+}
+
+
+/*
+ *  m*          ( ?? --  )
+ */
+
+static void mmult(void)
+{
+	const cell u2 = POP();
+	const cell u1 = POP();
+#ifdef NEED_FAKE_INT128_T
+        ducell c;
+
+        if (0) { // XXX How to detect overflow?
+            fprintf(stderr, "mmult called (%016llx * 0x%016llx)\n", u1, u2);
+            exit(-1);
+        }
+        c.hi = 0;
+        c.lo = u1 * u2;
+        DPUSH(c);
+#else
+	DPUSH((dcell) u1 * u2);
+#endif
+}
+
+
+/*
+ *  um*         ( u1 u2 -- d.prod )
+ */
+
+static void ummult(void)
+{
+	const ucell u2 = POP();
+	const ucell u1 = POP();
+#ifdef NEED_FAKE_INT128_T
+        ducell c;
+
+        if (0) { // XXX How to detect overflow?
+            fprintf(stderr, "ummult called (%016llx * 0x%016llx)\n", u1, u2);
+            exit(-1);
+        }
+        c.hi = 0;
+        c.lo = u1 * u2;
+        DPUSH(c);
+#else
+	DPUSH((ducell) u1 * u2);
+#endif
+}
+
+
+/*
+ *  @           ( a-addr -- x )
+ */
+
+static void fetch(void)
+{
+	const ucell *aaddr = (ucell *)cell2pointer(POP());
+	PUSH(read_ucell(aaddr));
+}
+
+
+/*
+ *  c@          ( addr -- byte )
+ */
+
+static void cfetch(void)
+{
+	const u8 *aaddr = (u8 *)cell2pointer(POP());
+	PUSH(read_byte(aaddr));
+}
+
+
+/*
+ *  w@          ( waddr -- w )
+ */
+
+static void wfetch(void)
+{
+	const u16 *aaddr = (u16 *)cell2pointer(POP());
+	PUSH(read_word(aaddr));
+}
+
+
+/*
+ *  l@          ( qaddr -- quad )
+ */
+
+static void lfetch(void)
+{
+	const u32 *aaddr = (u32 *)cell2pointer(POP());
+	PUSH(read_long(aaddr));
+}
+
+
+/*
+ *  !           ( x a-addr -- )
+ */
+
+static void store(void)
+{
+	const ucell *aaddr = (ucell *)cell2pointer(POP());
+	const ucell x = POP();
+#ifdef CONFIG_DEBUG_INTERNAL
+	printk("!: %lx : %lx -> %lx\n", aaddr, read_ucell(aaddr), x);
+#endif
+	write_ucell(aaddr,x);
+}
+
+
+/*
+ *  +!          ( nu a-addr -- )
+ */
+
+static void plusstore(void)
+{
+	const ucell *aaddr = (ucell *)cell2pointer(POP());
+	const cell nu = POP();
+	write_cell(aaddr,read_cell(aaddr)+nu);
+}
+
+
+/*
+ *  c!          ( byte addr -- )
+ */
+
+static void cstore(void)
+{
+	const u8 *aaddr = (u8 *)cell2pointer(POP());
+	const ucell byte = POP();
+#ifdef CONFIG_DEBUG_INTERNAL
+	printk("c!: %x = %x\n", aaddr, byte);
+#endif
+	write_byte(aaddr, byte);
+}
+
+
+/*
+ *  w!          ( w waddr -- )
+ */
+
+static void wstore(void)
+{
+	const u16 *aaddr = (u16 *)cell2pointer(POP());
+	const u16 word = POP();
+	write_word(aaddr, word);
+}
+
+
+/*
+ *  l!          ( quad qaddr -- )
+ */
+
+static void lstore(void)
+{
+	const u32 *aaddr = (u32 *)cell2pointer(POP());
+	const u32 longval = POP();
+	write_long(aaddr, longval);
+}
+
+
+/*
+ *  =           ( x1 x2 -- equal? )
+ */
+
+static void equals(void)
+{
+	cell tmp = (POP() == POP());
+	PUSH(-tmp);
+}
+
+
+/*
+ *  >           ( n1 n2 -- greater? )
+ */
+
+static void greater(void)
+{
+	cell tmp = ((cell) POP() < (cell) POP());
+	PUSH(-tmp);
+}
+
+
+/*
+ *  <           ( n1 n2 -- less? )
+ */
+
+static void less(void)
+{
+	cell tmp = ((cell) POP() > (cell) POP());
+	PUSH(-tmp);
+}
+
+
+/*
+ *  u>          ( u1 u2 -- unsigned-greater? )
+ */
+
+static void ugreater(void)
+{
+	cell tmp = ((ucell) POP() < (ucell) POP());
+	PUSH(-tmp);
+}
+
+
+/*
+ *  u<          ( u1 u2 -- unsigned-less? )
+ */
+
+static void uless(void)
+{
+	cell tmp = ((ucell) POP() > (ucell) POP());
+	PUSH(-tmp);
+}
+
+
+/*
+ *  sp@         (  -- stack-pointer )
+ */
+
+static void spfetch(void)
+{
+	// FIXME this can only work if the stack pointer
+	// is within range.
+	ucell tmp = pointer2cell(&(dstack[dstackcnt]));
+	PUSH(tmp);
+}
+
+
+/*
+ *  move        ( src-addr dest-addr len -- )
+ */
+
+static void fmove(void)
+{
+	ucell count = POP();
+	void *dest = (void *)cell2pointer(POP());
+	const void *src = (const void *)cell2pointer(POP());
+	memmove(dest, src, count);
+}
+
+
+/*
+ *  fill        ( addr len byte -- )
+ */
+
+static void ffill(void)
+{
+	ucell value = POP();
+	ucell count = POP();
+	void *src = (void *)cell2pointer(POP());
+	memset(src, value, count);
+}
+
+
+/*
+ *  unaligned-w@  ( addr -- w )
+ */
+
+static void unalignedwordread(void)
+{
+	const unsigned char *addr = (const unsigned char *) cell2pointer(POP());
+	PUSH(unaligned_read_word(addr));
+}
+
+
+/*
+ *  unaligned-w!  ( w addr -- )
+ */
+
+static void unalignedwordwrite(void)
+{
+	const unsigned char *addr = (const unsigned char *) cell2pointer(POP());
+	u16 w = POP();
+	unaligned_write_word(addr, w);
+}
+
+
+/*
+ *  unaligned-l@  ( addr -- quad )
+ */
+
+static void unalignedlongread(void)
+{
+	const unsigned char *addr = (const unsigned char *) cell2pointer(POP());
+	PUSH(unaligned_read_long(addr));
+}
+
+
+/*
+ *  unaligned-l!  ( quad addr -- )
+ */
+
+static void unalignedlongwrite(void)
+{
+	unsigned char *addr = (unsigned char *) cell2pointer(POP());
+	u32 l = POP();
+	unaligned_write_long(addr, l);
+}
+
+/*
+ *  here        (  -- dictionary-pointer )
+ */
+
+static void here(void)
+{
+	PUSH(pointer2cell(dict) + dicthead);
+#ifdef CONFIG_DEBUG_INTERNAL
+	printk("here: %x\n", pointer2cell(dict) + dicthead);
+#endif
+}
+
+/*
+ *  here!       ( new-dict-pointer -- )
+ */
+
+static void herewrite(void)
+{
+	ucell tmp = POP(); /* converted pointer */
+	dicthead = tmp - pointer2cell(dict);
+#ifdef CONFIG_DEBUG_INTERNAL
+	printk("here!: new value: %x\n", tmp);
+#endif
+
+	if (dictlimit && dicthead >= dictlimit) {
+	    printk("Dictionary space overflow:"
+	            " dicthead=" FMT_ucellx
+	            " dictlimit=" FMT_ucellx
+	            "\n",
+	            dicthead, dictlimit);
+	}
+}
+
+
+/*
+ *   emit       ( char --  )
+ */
+
+static void emit(void)
+{
+	cell tmp = POP();
+#ifndef FCOMPILER
+	putchar(tmp);
+#else
+       	put_outputbyte(tmp);
+#endif
+}
+
+
+/*
+ *   key?       (  -- pressed? )
+ */
+
+static void iskey(void)
+{
+	PUSH((cell) availchar());
+}
+
+
+/*
+ *   key        (  -- char )
+ */
+
+static void key(void)
+{
+	while (!availchar());
+#ifdef FCOMPILER
+	PUSH(get_inputbyte());
+#else
+	PUSH(getchar());
+#endif
+}
+
+
+/*
+ *   ioc@       ( reg -- val )
+ */
+
+static void iocfetch(void)
+{
+#ifndef FCOMPILER
+	cell reg = POP();
+	PUSH(inb(reg));
+#else
+        (void)POP();
+        PUSH(0);
+#endif
+}
+
+
+/*
+ *   iow@       ( reg -- val )
+ */
+
+static void iowfetch(void)
+{
+#ifndef FCOMPILER
+	cell reg = POP();
+	PUSH(inw(reg));
+#else
+        (void)POP();
+        PUSH(0);
+#endif
+}
+
+/*
+ *   iol@       ( reg -- val )
+ */
+
+static void iolfetch(void)
+{
+#ifndef FCOMPILER
+	cell reg = POP();
+	PUSH(inl(reg));
+#else
+        (void)POP();
+        PUSH(0);
+#endif
+}
+
+
+/*
+ *   ioc!       ( val reg --  )
+ */
+
+static void iocstore(void)
+{
+#ifndef FCOMPILER
+	cell reg = POP();
+	cell val = POP();
+
+	outb(val, reg);
+#else
+        (void)POP();
+        (void)POP();
+#endif
+}
+
+
+/*
+ *   iow!       ( val reg --  )
+ */
+
+static void iowstore(void)
+{
+#ifndef FCOMPILER
+	cell reg = POP();
+	cell val = POP();
+
+	outw(val, reg);
+#else
+        (void)POP();
+        (void)POP();
+#endif
+}
+
+
+/*
+ *   iol!       ( val reg --  )
+ */
+
+static void iolstore(void)
+{
+#ifndef FCOMPILER
+	ucell reg = POP();
+	ucell val = POP();
+
+	outl(val, reg);
+#else
+        (void)POP();
+        (void)POP();
+#endif
+}
+
+/*
+ *   i         ( -- i )
+ */
+
+static void loop_i(void)
+{
+	PUSH(rstack[rstackcnt]);
+}
+
+/*
+ *   j         ( -- i )
+ */
+
+static void loop_j(void)
+{
+	PUSH(rstack[rstackcnt - 2]);
+}
+
+/* words[] is a function array of all native code functions used by
+ * the dictionary, i.e. CFAs and primitives.
+ * Any change here needs a matching change in the primitive word's
+ * name list that is kept for bootstrapping in kernel/bootstrap.c
+ *
+ * NOTE: THIS LIST SHALL NOT CHANGE (EXCEPT MANDATORY ADDITIONS AT
+ * THE END). ANY OTHER CHANGE WILL BREAK COMPATIBILITY TO OLDER
+ * BINARY DICTIONARIES.
+ */
+static forth_word * const words[] = {
+    /*
+     * CFAs and special words
+     */
+    semis,
+    docol,
+    lit,
+    docon,
+    dovar,
+    dodefer,
+    dodoes,
+    dodo,
+    doisdo,
+    doloop,
+    doplusloop,
+    doival,
+    doivar,
+    doidefer,
+
+    /*
+     * primitives
+     */
+    fdup,                   /* dup     */
+    twodup,                 /* 2dup    */
+    isdup,                  /* ?dup    */
+    over,                   /* over    */
+    twoover,                /* 2over   */
+    pick,                   /* pick    */
+    drop,                   /* drop    */
+    twodrop,                /* 2drop   */
+    nip,                    /* nip     */
+    roll,                   /* roll    */
+    rot,                    /* rot     */
+    minusrot,               /* -rot    */
+    swap,                   /* swap    */
+    twoswap,                /* 2swap   */
+    tor,                    /* >r      */
+    rto,                    /* r>      */
+    rfetch,                 /* r@      */
+    depth,                  /* depth   */
+    depthwrite,             /* depth!  */
+    rdepth,                 /* rdepth  */
+    rdepthwrite,            /* rdepth! */
+    plus,                   /* +       */
+    minus,                  /* -       */
+    mult,                   /* *       */
+    umult,                  /* u*      */
+    mudivmod,               /* mu/mod  */
+    forthabs,               /* abs     */
+    negate,                 /* negate  */
+    max,                    /* max     */
+    min,                    /* min     */
+    lshift,                 /* lshift  */
+    rshift,                 /* rshift  */
+    rshifta,                /* >>a     */
+    and,                    /* and     */
+    or,                     /* or      */
+    xor,                    /* xor     */
+    invert,                 /* invert  */
+    dplus,                  /* d+      */
+    dminus,                 /* d-      */
+    mmult,                  /* m*      */
+    ummult,                 /* um*     */
+    fetch,                  /* @       */
+    cfetch,                 /* c@      */
+    wfetch,                 /* w@      */
+    lfetch,                 /* l@      */
+    store,                  /* !       */
+    plusstore,              /* +!      */
+    cstore,                 /* c!      */
+    wstore,                 /* w!      */
+    lstore,                 /* l!      */
+    equals,                 /* =       */
+    greater,                /* >       */
+    less,                   /* <       */
+    ugreater,               /* u>      */
+    uless,                  /* u<      */
+    spfetch,                /* sp@     */
+    fmove,                  /* move    */
+    ffill,                  /* fill    */
+    emit,                   /* emit    */
+    iskey,                  /* key?    */
+    key,                    /* key     */
+    execute,                /* execute */
+    here,                   /* here    */
+    herewrite,              /* here!   */
+    dobranch,               /* dobranch     */
+    docbranch,              /* do?branch    */
+    unalignedwordread,      /* unaligned-w@ */
+    unalignedwordwrite,     /* unaligned-w! */
+    unalignedlongread,      /* unaligned-l@ */
+    unalignedlongwrite,     /* unaligned-l! */
+    iocfetch,               /* ioc@    */
+    iowfetch,               /* iow@    */
+    iolfetch,               /* iol@    */
+    iocstore,               /* ioc!    */
+    iowstore,               /* iow!    */
+    iolstore,               /* iol!    */
+    loop_i,                 /* i       */
+    loop_j,                 /* j       */
+    call,                   /* call    */
+    sysdebug,               /* sys-debug */
+    do_include,             /* $include */
+    do_encode_file,         /* $encode-file */
+    do_debug_xt,            /* (debug  */
+    do_debug_off,           /* (debug-off) */
+};