#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <ctype.h>
#include <stdarg.h>
#include <setjmp.h>
#include <time.h>

typedef long cell;

#define NSTACK 4096
#define NRSTACK 8192
#define NENTRY 16384
#define LPOOL 65536
#define SPOOL 65536
#define DPOOL 131072
#define SRCMAX 1048576
#define MAXTOK 64
#define CSPMAX 128
#define LEAVEMAX 24
#define F_IMM 1

typedef struct entry {
    struct entry *link;
    char *name;
    unsigned char len;
    unsigned char flags;
    void (*code)(void);
    cell *param;
    cell *does_list;
} entry;

#define C2P(v) ((entry *)(void *)(v))
#define C2PP(v) ((entry **)(void *)(v))
#define P2C(p) ((cell)(void *)(p))

static cell dst[NSTACK];
static int dsp;
static cell rst[NRSTACK];
static int drst;
static entry epool[NENTRY];
static int etop;
static entry *dict;
static cell lpool[LPOOL];
static int ltop;
static cell spool[SPOOL];
static int sptop;
static cell dpool[DPOOL];
static int dtop;
static cell base_cell = 10;
static entry *cur;
static entry *defining;
static entry *last_create;
static int def_lstart;
static int state;
static entry **ip;
static char *src;
static long srclen;
static int toin;
static char tok[MAXTOK];
static int toklen;
static jmp_buf abort_jmp;
static int jmp_ready;
static int errflag;
static int quitting;
static entry *__semi;
static entry *__do;
static entry *__doesx;

enum { K_IF, K_ELSE, K_BEGIN, K_WHILE, K_DO };

typedef struct {
    int kind;
    entry *e;
    int idx;
    entry *leaves[LEAVEMAX];
    int nleave;
} csnap;

static csnap csp[CSPMAX];
static int ncsp;

static void run(entry *e);
static entry *lookup(const char *s);
static void compile_ref(entry *e);
static entry *box(void (*c)(void), int nparam);
static void interpret(void);

static void err(const char *fmt, ...)
{
    va_list ap;
    printf("ERROR: ");
    va_start(ap, fmt);
    vprintf(fmt, ap);
    va_end(ap);
    printf("\n");
    fflush(stdout);
    if (!jmp_ready) {
        exit(2);
    }
    errflag = 1;
    longjmp(abort_jmp, 1);
}

static void push(cell v)
{
    if (dsp >= NSTACK) err("stack overflow");
    dst[dsp++] = v;
}

static cell pop(void)
{
    if (dsp <= 0) err("stack underflow");
    return dst[--dsp];
}

static void rpush(cell v)
{
    if (drst >= NRSTACK) err("return stack overflow");
    rst[drst++] = v;
}

static cell rpop(void)
{
    if (drst <= 0) err("return stack underflow");
    return rst[--drst];
}

static entry *new_ent(void)
{
    if (etop >= NENTRY) err("dictionary full");
    return &epool[etop++];
}

static cell *spool_alloc(int n)
{
    cell *p;
    if (n <= 0) n = 1;
    if (sptop + n > SPOOL) err("string pool full");
    p = &spool[sptop];
    sptop += n;
    return p;
}

static entry *hidden(void (*c)(void))
{
    entry *e = new_ent();
    e->link = NULL;
    e->name = NULL;
    e->len = 0;
    e->flags = 0;
    e->code = c;
    e->param = NULL;
    e->does_list = NULL;
    return e;
}

static entry *define(const char *name, void (*c)(void))
{
    entry *e = new_ent();
    size_t n = strlen(name);
    if (n >= 256) err("name too long");
    e->name = (char *)spool_alloc((int)((n + 1 + sizeof(cell) - 1) / sizeof(cell)));
    memcpy(e->name, name, n);
    e->name[n] = 0;
    e->len = (unsigned char)n;
    e->flags = 0;
    e->code = c;
    e->param = NULL;
    e->does_list = NULL;
    e->link = dict;
    dict = e;
    return e;
}

static entry *box(void (*c)(void), int nparam)
{
    entry *e = new_ent();
    e->link = NULL;
    e->name = NULL;
    e->len = 0;
    e->flags = 0;
    e->code = c;
    e->param = spool_alloc(nparam);
    e->does_list = NULL;
    return e;
}

static void compile_ref(entry *e)
{
    if (!defining) err("compiling outside a definition");
    if (ltop >= LPOOL) err("code pool full");
    lpool[ltop++] = P2C(e);
}

static void cpush(int kind, entry *e, int idx)
{
    if (ncsp >= CSPMAX) err("control stack full");
    csp[ncsp].kind = kind;
    csp[ncsp].e = e;
    csp[ncsp].idx = idx;
    csp[ncsp].nleave = 0;
    ncsp++;
}

static csnap *cpop(int kind)
{
    if (ncsp <= 0) err("control stack empty (mismatched %s)",
        kind == K_IF ? "IF" : kind == K_ELSE ? "ELSE" :
        kind == K_BEGIN ? "BEGIN" : kind == K_WHILE ? "WHILE" : "DO");
    if (csp[ncsp - 1].kind != kind) err("control-flow mismatch");
    return &csp[--ncsp];
}

static void do_colon(void)
{
    rpush(P2C(ip));
    ip = C2PP(cur->param);
}

static void do_semi(void)
{
    ip = C2PP(rpop());
}

static void do_exit(void)
{
    ip = C2PP(rpop());
}

static void do_lit(void)
{
    push(cur->param[0]);
}

static void do_const(void)
{
    push(cur->param[0]);
}

static void do_create(void)
{
    push(P2C(cur->param));
}

static void do_does(void)
{
    push(P2C(cur->param));
    rpush(P2C(ip));
    ip = C2PP(cur->does_list);
}

static void do_doesx(void)
{
    if (!last_create) err("DOES> without CREATE");
    last_create->does_list = (cell *)(void *)ip;
    last_create->code = do_does;
    last_create = NULL;
    ip = C2PP(rpop());
}

static void do_branch(void)
{
    ip = C2PP(cur->param[0]);
}

static void do_zbranch(void)
{
    if (pop() == 0) ip = C2PP(cur->param[0]);
}

static void do_do(void)
{
    cell start = pop();
    cell limit = pop();
    rpush(limit);
    rpush(start);
}

static void do_qdo(void)
{
    cell start = pop();
    cell limit = pop();
    if (start >= limit) {
        ip = C2PP(cur->param[0]);
    } else {
        rpush(limit);
        rpush(start);
    }
}

static void do_loop(void)
{
    cell lim, i;
    if (drst < 2) err("LOOP without DO");
    lim = rst[drst - 2];
    i = rst[drst - 1] + 1;
    if (i >= lim) drst -= 2;
    else {
        rst[drst - 1] = i;
        ip = C2PP(cur->param[0]);
    }
}

static void do_plusloop(void)
{
    cell step, lim, i;
    if (drst < 2) err("+LOOP without DO");
    step = pop();
    lim = rst[drst - 2];
    i = rst[drst - 1] + step;
    if ((step > 0 && i >= lim) || (step < 0 && i < lim)) drst -= 2;
    else {
        rst[drst - 1] = i;
        ip = C2PP(cur->param[0]);
    }
}

static void do_leave(void)
{
    if (drst < 2) err("LEAVE without a loop");
    drst -= 2;
    ip = C2PP(cur->param[0]);
}

static void do_i(void)
{
    if (drst < 2) err("I outside of a loop");
    push(rst[drst - 1]);
}

static void do_j(void)
{
    if (drst < 4) err("J outside of a nested loop");
    push(rst[drst - 3]);
}

static void do_unloop(void)
{
    rpop();
    rpop();
}

static void do_add(void) { cell b = pop(), a = pop(); push(a + b); }
static void do_sub(void) { cell b = pop(), a = pop(); push(a - b); }
static void do_mul(void) { cell b = pop(), a = pop(); push(a * b); }
static void do_div(void) { cell b = pop(), a = pop(); if (b == 0) err("divide by zero"); push(a / b); }
static void do_mod(void) { cell b = pop(), a = pop(); if (b == 0) err("divide by zero"); push(a % b); }
static void do_divmod(void)
{
    cell b = pop(), a = pop();
    if (b == 0) err("divide by zero");
    push(a % b);
    push(a / b);
}
static void do_negate(void) { push(-pop()); }
static void do_abs(void) { cell a = pop(); push(a < 0 ? -a : a); }
static void do_min(void) { cell b = pop(), a = pop(); push(a < b ? a : b); }
static void do_max(void) { cell b = pop(), a = pop(); push(a > b ? a : b); }
static void do_onep(void) { push(pop() + 1); }
static void do_onem(void) { push(pop() - 1); }
static void do_twomul(void) { push(pop() * 2); }
static void do_twodiv(void) { push(pop() / 2); }

static void do_eq(void) { cell b = pop(), a = pop(); push(a == b ? -1 : 0); }
static void do_ne(void) { cell b = pop(), a = pop(); push(a != b ? -1 : 0); }
static void do_lt(void) { cell b = pop(), a = pop(); push(a < b ? -1 : 0); }
static void do_gt(void) { cell b = pop(), a = pop(); push(a > b ? -1 : 0); }
static void do_le(void) { cell b = pop(), a = pop(); push(a <= b ? -1 : 0); }
static void do_ge(void) { cell b = pop(), a = pop(); push(a >= b ? -1 : 0); }
static void do_zeq(void) { push(pop() == 0 ? -1 : 0); }
static void do_zlt(void) { push(pop() < 0 ? -1 : 0); }
static void do_zgt(void) { push(pop() > 0 ? -1 : 0); }
static void do_zne(void) { push(pop() != 0 ? -1 : 0); }
static void do_and(void) { cell b = pop(), a = pop(); push(a & b); }
static void do_or(void) { cell b = pop(), a = pop(); push(a | b); }
static void do_xor(void) { cell b = pop(), a = pop(); push(a ^ b); }
static void do_invert(void) { push(~pop()); }
static void do_not(void) { push(pop() == 0 ? -1 : 0); }

static void do_dup(void) { if (dsp < 1) err("stack underflow"); push(dst[dsp - 1]); }
static void do_qdup(void)
{
    if (dsp < 1) err("stack underflow");
    if (dst[dsp - 1] != 0) push(dst[dsp - 1]);
}
static void do_drop(void) { (void)pop(); }
static void do_swap(void) { cell b = pop(), a = pop(); push(b); push(a); }
static void do_over(void)
{
    if (dsp < 2) err("stack underflow");
    push(dst[dsp - 2]);
}
static void do_rot(void)
{
    cell c = pop(), b = pop(), a = pop();
    push(b); push(c); push(a);
}
static void do_nrot(void)
{
    cell c = pop(), b = pop(), a = pop();
    push(c); push(a); push(b);
}
static void do_nip(void) { cell b = pop(); (void)pop(); push(b); }
static void do_tuck(void)
{
    cell b = pop(), a = pop();
    push(b); push(a); push(b);
}
static void do_pick(void)
{
    cell u = pop();
    if (u < 0 || u >= dsp) err("PICK out of range");
    push(dst[dsp - 1 - (int)u]);
}
static void do_depth(void) { push((cell)dsp); }
static void do_2dup(void)
{
    if (dsp < 2) err("stack underflow");
    push(dst[dsp - 2]); push(dst[dsp - 2]);
}
static void do_2drop(void) { (void)pop(); (void)pop(); }
static void do_2swap(void)
{
    cell d = pop(), c = pop(), b = pop(), a = pop();
    push(c); push(d); push(a); push(b);
}

static void do_tor(void) { rpush(pop()); }
static void do_rfrom(void) { push(rpop()); }
static void do_r_fetch(void)
{
    if (drst < 1) err("return stack underflow");
    push(rst[drst - 1]);
}

static void do_fetch(void) { cell *p = (cell *)(void *)pop(); push(*p); }
static void do_store(void) { cell *p = (cell *)(void *)pop(); *p = pop(); }
static void do_cfetch(void) { unsigned char *p = (unsigned char *)(void *)pop(); push((cell)*p); }
static void do_cstore(void) { unsigned char *p = (unsigned char *)(void *)pop(); *p = (unsigned char)pop(); }
static void do_plusstore(void) { cell *p = (cell *)(void *)pop(); *p += pop(); }
static void do_cells(void) { push(pop() * (cell)sizeof(cell)); }
static void do_cellp(void) { push(pop() + (cell)sizeof(cell)); }
static void do_chars(void) { }
static void do_charp(void) { push(pop() + 1); }
static void do_here(void) { push(P2C(&dpool[dtop])); }
static void do_allot(void)
{
    cell n = pop();
    cell cells = (n + (cell)sizeof(cell) - 1) / (cell)sizeof(cell);
    if (dtop + cells < 0 || dtop + cells > DPOOL) err("ALLOT out of range");
    dtop += (int)cells;
}
static void do_comma(void)
{
    if (dtop >= DPOOL) err("data space full");
    dpool[dtop++] = pop();
}
static void do_fill(void)
{
    cell c = pop(), n = pop();
    char *a = (char *)(void *)pop();
    if (n < 0) err("bad FILL count");
    memset(a, (int)(c & 0xff), (size_t)n);
}
static void do_erase(void)
{
    cell n = pop();
    char *a = (char *)(void *)pop();
    if (n < 0) err("bad ERASE count");
    memset(a, 0, (size_t)n);
}

static void do_dot(void) { printf("%ld ", pop()); }
static void do_udot(void) { printf("%lu ", (unsigned long)pop()); }
static void do_dotr(void)
{
    cell w = pop(), v = pop();
    printf("%*ld", (int)w, v);
}
static void do_emit(void) { putchar((int)(pop() & 0xff)); }
static void do_cr(void) { putchar('\n'); }
static void do_space(void) { putchar(' '); }
static void do_spaces(void)
{
    cell n = pop();
    while (n-- > 0) putchar(' ');
}
static void do_type(void)
{
    cell n = pop();
    char *a = (char *)(void *)pop();
    if (n < 0) err("bad TYPE count");
    fwrite(a, 1, (size_t)n, stdout);
}
static void do_dotq(void)
{
    fwrite((char *)(void *)cur->param[0], 1, (size_t)cur->param[1], stdout);
}
static void do_sq(void)
{
    push(cur->param[0]);
    push(cur->param[1]);
}
static void do_words(void)
{
    entry *e;
    for (e = dict; e; e = e->link) printf("%s ", e->name);
    putchar('\n');
}
static void do_dots(void)
{
    int i;
    printf("<%d> ", dsp);
    for (i = 0; i < dsp; i++) printf("%ld ", dst[i]);
    putchar('\n');
}
static void do_clock(void) { push((cell)clock()); }
static void do_hex(void) { base_cell = 16; }
static void do_decimal(void) { base_cell = 10; }

static void do_execute(void)
{
    entry *e = C2P(pop());
    if (e < epool || e >= &epool[etop]) err("bad execution token");
    run(e);
}

static int next_word(void)
{
    int n = 0, i;
    while (toin < srclen && isspace((unsigned char)src[toin])) toin++;
    while (toin < srclen && !isspace((unsigned char)src[toin]) && n < MAXTOK - 1)
        tok[n++] = src[toin++];
    for (i = 0; i < n; i++) tok[i] = (char)toupper((unsigned char)tok[i]);
    tok[n] = 0;
    toklen = n;
    return n;
}

static int parse_q(char *buf, int max)
{
    int n = 0;
    while (toin < srclen && src[toin] != '"' && n < max - 1) buf[n++] = src[toin++];
    if (toin >= srclen) err("missing closing quote");
    toin++;
    buf[n] = 0;
    return n;
}

static cell dp_bytes(const char *b, int n)
{
    cell base = (cell)dtop;
    cell cells = (n + (cell)sizeof(cell) - 1) / (cell)sizeof(cell);
    if (dtop + cells > DPOOL) err("data space full");
    memcpy(&dpool[dtop], b, (size_t)n);
    dtop += (int)cells;
    return P2C(&dpool[base]);
}

static entry *lookup(const char *s)
{
    entry *e;
    for (e = dict; e; e = e->link) {
        if ((int)e->len == toklen && strlen(s) == (size_t)toklen) {
            if (memcmp(e->name, s, (size_t)toklen) == 0) return e;
        }
    }
    return NULL;
}

static int number(cell *out)
{
    char *end;
    long v;
    if (toklen == 0) return 0;
    v = strtol(tok, &end, (int)base_cell);
    if (*end == 0 && end != tok) {
        *out = (cell)v;
        return 1;
    }
    return 0;
}

static void run(entry *e)
{
    entry *list[2];
    entry **save = ip;
    list[0] = e;
    list[1] = __semi;
    ip = list;
    for (;;) {
        cur = *ip;
        ip++;
        if (ip == list + 2) break;
        cur->code();
    }
    ip = save;
}

static void c_colon(void)
{
    entry *e;
    if (state) err("nested :");
    if (next_word() == 0) err(": needs a name");
    e = define(tok, do_colon);
    state = 1;
    defining = e;
    def_lstart = ltop;
}

static void c_semi(void)
{
    if (!defining) err("; without :");
    compile_ref(__semi);
    defining->param = &lpool[def_lstart];
    state = 0;
    defining = NULL;
}

static void c_recurse(void)
{
    if (!defining) err("RECURSE outside a definition");
    compile_ref(defining);
}

static void c_literal(void)
{
    cell v;
    entry *e;
    if (!state) err("LITERAL outside a definition");
    v = pop();
    e = box(do_lit, 1);
    e->param[0] = v;
    compile_ref(e);
}

static void c_immediate(void) { dict->flags |= F_IMM; }

static void c_lbrack(void) { state = 0; }
static void c_rbrack(void)
{
    if (!defining) err("] without a definition in progress");
    state = 1;
}

static void c_if(void)
{
    entry *e;
    if (!state) err("IF outside a definition");
    e = box(do_zbranch, 1);
    e->param[0] = 0;
    compile_ref(e);
    cpush(K_IF, e, 0);
}

static void c_else(void)
{
    entry *eif, *ebr;
    if (!state) err("ELSE outside a definition");
    eif = cpop(K_IF)->e;
    ebr = box(do_branch, 1);
    ebr->param[0] = 0;
    compile_ref(ebr);
    eif->param[0] = P2C(&lpool[ltop]);
    cpush(K_ELSE, ebr, 0);
}

static void c_then(void)
{
    csnap *s = NULL;
    if (!state) err("THEN outside a definition");
    if (ncsp > 0 && (csp[ncsp - 1].kind == K_IF || csp[ncsp - 1].kind == K_ELSE))
        s = &csp[--ncsp];
    else
        err("THEN without IF");
    s->e->param[0] = P2C(&lpool[ltop]);
}

static void c_begin(void)
{
    if (!state) err("BEGIN outside a definition");
    cpush(K_BEGIN, NULL, ltop);
}

static void c_until(void)
{
    csnap *s;
    entry *e;
    if (!state) err("UNTIL outside a definition");
    s = cpop(K_BEGIN);
    e = box(do_zbranch, 1);
    e->param[0] = P2C(&lpool[s->idx]);
    compile_ref(e);
}

static void c_again(void)
{
    csnap *s;
    entry *e;
    if (!state) err("AGAIN outside a definition");
    s = cpop(K_BEGIN);
    e = box(do_branch, 1);
    e->param[0] = P2C(&lpool[s->idx]);
    compile_ref(e);
}

static void c_while(void)
{
    entry *e;
    if (!state) err("WHILE outside a definition");
    if (ncsp <= 0 || csp[ncsp - 1].kind != K_BEGIN) err("WHILE without BEGIN");
    e = box(do_zbranch, 1);
    e->param[0] = 0;
    compile_ref(e);
    cpush(K_WHILE, e, csp[ncsp - 1].idx);
}

static void c_repeat(void)
{
    csnap *w, *b;
    entry *e;
    if (!state) err("REPEAT outside a definition");
    w = cpop(K_WHILE);
    b = cpop(K_BEGIN);
    e = box(do_branch, 1);
    e->param[0] = P2C(&lpool[b->idx]);
    compile_ref(e);
    w->e->param[0] = P2C(&lpool[ltop]);
}

static void c_do(void)
{
    if (!state) err("DO outside a definition");
    compile_ref(__do);
    cpush(K_DO, NULL, ltop);
}

static void c_qdo(void)
{
    entry *e;
    csnap *d;
    if (!state) err("?DO outside a definition");
    e = box(do_qdo, 1);
    e->param[0] = 0;
    compile_ref(e);
    cpush(K_DO, NULL, ltop);
    d = &csp[ncsp - 1];
    if (d->nleave >= LEAVEMAX) err("too many LEAVEs in one loop");
    d->leaves[d->nleave++] = e;
}

static void c_leave(void)
{
    int i;
    csnap *d = NULL;
    if (!state) err("LEAVE outside a definition");
    for (i = ncsp - 1; i >= 0; i--)
        if (csp[i].kind == K_DO) { d = &csp[i]; break; }
    if (!d) err("LEAVE without DO");
    if (d->nleave >= LEAVEMAX) err("too many LEAVEs in one loop");
    {
        entry *e = box(do_leave, 1);
        e->param[0] = 0;
        compile_ref(e);
        d->leaves[d->nleave++] = e;
    }
}

static void close_loop(void (*loopcode)(void))
{
    csnap *d;
    entry *lw;
    int i;
    d = cpop(K_DO);
    lw = box(loopcode, 1);
    lw->param[0] = P2C(&lpool[d->idx]);
    compile_ref(lw);
    for (i = 0; i < d->nleave; i++)
        d->leaves[i]->param[0] = P2C(&lpool[ltop]);
}

static void c_loop(void)
{
    if (!state) err("LOOP outside a definition");
    close_loop(do_loop);
}

static void c_plusloop(void)
{
    if (!state) err("+LOOP outside a definition");
    close_loop(do_plusloop);
}

static void c_create(void)
{
    entry *e;
    if (next_word() == 0) err("CREATE needs a name");
    e = define(tok, do_create);
    e->param = &dpool[dtop];
    last_create = e;
}

static void c_variable(void)
{
    entry *e;
    if (next_word() == 0) err("VARIABLE needs a name");
    e = define(tok, do_create);
    if (dtop >= DPOOL) err("data space full");
    e->param = &dpool[dtop];
    dpool[dtop++] = 0;
    last_create = e;
}

static void c_constant(void)
{
    entry *e;
    cell v = pop();
    if (next_word() == 0) err("CONSTANT needs a name");
    e = define(tok, do_const);
    e->param = spool_alloc(1);
    e->param[0] = v;
}

static void c_does(void)
{
    if (!state) err("DOES> outside a definition");
    compile_ref(__doesx);
}

static void c_char(void)
{
    entry *e;
    cell c;
    if (next_word() == 0) err("CHAR needs a word");
    c = (cell)(unsigned char)tok[0];
    if (state) {
        e = box(do_lit, 1);
        e->param[0] = c;
        compile_ref(e);
    } else {
        push(c);
    }
}

static void c_dotq(void)
{
    char buf[256];
    int n;
    entry *e;
    if (toin < srclen && src[toin] == ' ') toin++;
    n = parse_q(buf, (int)sizeof(buf));
    if (state) {
        cell a = dp_bytes(buf, n);
        e = box(do_dotq, 2);
        e->param[0] = a;
        e->param[1] = n;
        compile_ref(e);
    } else {
        fwrite(buf, 1, (size_t)n, stdout);
    }
}

static void c_sq(void)
{
    char buf[256];
    int n;
    entry *e;
    if (toin < srclen && src[toin] == ' ') toin++;
    n = parse_q(buf, (int)sizeof(buf));
    if (state) {
        cell a = dp_bytes(buf, n);
        e = box(do_sq, 2);
        e->param[0] = a;
        e->param[1] = n;
        compile_ref(e);
    } else {
        push(dp_bytes(buf, n));
        push((cell)n);
    }
}

static void c_paren(void)
{
    while (toin < srclen && src[toin] != ')') toin++;
    if (toin >= srclen) err("( without )");
    toin++;
}

static void c_backslash(void)
{
    while (toin < srclen && src[toin] != '\n') toin++;
}

static void c_tick(void)
{
    entry *e;
    if (next_word() == 0) err("' needs a word");
    e = lookup(tok);
    if (!e) err("' : %s is undefined", tok);
    push(P2C(e));
}

static void c_bye(void) { exit(0); }

static void c_quit(void)
{
    dsp = 0;
    drst = 0;
    quitting = 1;
    longjmp(abort_jmp, 2);
}

static void c_abort(void)
{
    printf("ABORTED\n");
    errflag = 1;
    quitting = 1;
    longjmp(abort_jmp, 2);
}

static void defprim(const char *name, void (*c)(void))
{
    (void)define(name, c);
}

static void defimm(const char *name, void (*c)(void))
{
    entry *e = define(name, c);
    e->flags |= F_IMM;
}

static void defconst(const char *name, cell v)
{
    entry *e = define(name, do_const);
    e->param = spool_alloc(1);
    e->param[0] = v;
}

static void init_dict(void)
{
    entry *e;
    __semi = hidden(do_semi);
    __do = hidden(do_do);
    __doesx = hidden(do_doesx);

    defprim("+", do_add);
    defprim("-", do_sub);
    defprim("*", do_mul);
    defprim("/", do_div);
    defprim("MOD", do_mod);
    defprim("/MOD", do_divmod);
    defprim("NEGATE", do_negate);
    defprim("ABS", do_abs);
    defprim("MIN", do_min);
    defprim("MAX", do_max);
    defprim("1+", do_onep);
    defprim("1-", do_onem);
    defprim("2*", do_twomul);
    defprim("2/", do_twodiv);

    defprim("=", do_eq);
    defprim("<>", do_ne);
    defprim("<", do_lt);
    defprim(">", do_gt);
    defprim("<=", do_le);
    defprim(">=", do_ge);
    defprim("0=", do_zeq);
    defprim("0<", do_zlt);
    defprim("0>", do_zgt);
    defprim("0<>", do_zne);
    defprim("AND", do_and);
    defprim("OR", do_or);
    defprim("XOR", do_xor);
    defprim("INVERT", do_invert);
    defprim("NOT", do_not);

    defprim("DUP", do_dup);
    defprim("?DUP", do_qdup);
    defprim("DROP", do_drop);
    defprim("SWAP", do_swap);
    defprim("OVER", do_over);
    defprim("ROT", do_rot);
    defprim("-ROT", do_nrot);
    defprim("NIP", do_nip);
    defprim("TUCK", do_tuck);
    defprim("PICK", do_pick);
    defprim("DEPTH", do_depth);
    defprim("2DUP", do_2dup);
    defprim("2DROP", do_2drop);
    defprim("2SWAP", do_2swap);

    defprim(">R", do_tor);
    defprim("R>", do_rfrom);
    defprim("R@", do_r_fetch);
    defprim("I", do_i);
    defprim("J", do_j);
    defprim("UNLOOP", do_unloop);
    defprim("EXIT", do_exit);

    defprim("@", do_fetch);
    defprim("!", do_store);
    defprim("C@", do_cfetch);
    defprim("C!", do_cstore);
    defprim("+!", do_plusstore);
    defprim("CELLS", do_cells);
    defprim("CELL+", do_cellp);
    defprim("CHARS", do_chars);
    defprim("CHAR+", do_charp);
    defprim("HERE", do_here);
    defprim("ALLOT", do_allot);
    defprim(",", do_comma);
    defprim("FILL", do_fill);
    defprim("ERASE", do_erase);

    defprim(".", do_dot);
    defprim("U.", do_udot);
    defprim(".R", do_dotr);
    defprim("EMIT", do_emit);
    defprim("CR", do_cr);
    defprim("SPACE", do_space);
    defprim("SPACES", do_spaces);
    defprim("TYPE", do_type);
    defprim("WORDS", do_words);
    defprim(".S", do_dots);
    defprim("CLOCK", do_clock);
    defprim("EXECUTE", do_execute);
    defprim("HEX", do_hex);
    defprim("DECIMAL", do_decimal);

    defconst("BL", 32);
    e = define("BASE", do_create);
    e->param = &base_cell;

    defimm(":", c_colon);
    defimm(";", c_semi);
    defimm("RECURSE", c_recurse);
    defimm("LITERAL", c_literal);
    defimm("IMMEDIATE", c_immediate);
    defimm("[", c_lbrack);
    defprim("]", c_rbrack);
    defimm("IF", c_if);
    defimm("ELSE", c_else);
    defimm("THEN", c_then);
    defimm("BEGIN", c_begin);
    defimm("UNTIL", c_until);
    defimm("AGAIN", c_again);
    defimm("WHILE", c_while);
    defimm("REPEAT", c_repeat);
    defimm("DO", c_do);
    defimm("?DO", c_qdo);
    defimm("LEAVE", c_leave);
    defimm("LOOP", c_loop);
    defimm("+LOOP", c_plusloop);
    defprim("CREATE", c_create);
    defprim("VARIABLE", c_variable);
    defprim("CONSTANT", c_constant);
    defimm("DOES>", c_does);
    defimm("CHAR", c_char);
    defimm("[CHAR]", c_char);
    defimm(".\"", c_dotq);
    defimm("S\"", c_sq);
    defimm("(", c_paren);
    defimm("\\", c_backslash);
    defprim("'", c_tick);
    defprim("BYE", c_bye);
    defprim("QUIT", c_quit);
    defprim("ABORT", c_abort);
}

static void interpret(void)
{
    cell v;
    entry *e;
    for (;;) {
        if (next_word() == 0) return;
        e = lookup(tok);
        if (e) {
            if (state && !(e->flags & F_IMM)) compile_ref(e);
            else run(e);
        } else if (number(&v)) {
            if (state) {
                entry *lit = box(do_lit, 1);
                lit->param[0] = v;
                compile_ref(lit);
            } else {
                push(v);
            }
        } else {
            err("undefined word: %s", tok);
        }
    }
}

int main(int argc, char **argv)
{
    FILE *f = stdin;
    size_t got;
    if (argc > 1) {
        f = fopen(argv[1], "rb");
        if (!f) {
            fprintf(stderr, "cannot open %s\n", argv[1]);
            return 2;
        }
    }
    src = (char *)malloc(SRCMAX + 1);
    if (!src) {
        fprintf(stderr, "out of memory\n");
        return 2;
    }
    got = fread(src, 1, SRCMAX, f);
    srclen = (long)got;
    src[srclen] = 0;
    if (f != stdin) fclose(f);
    init_dict();
    jmp_ready = 1;
    if (setjmp(abort_jmp) == 0) {
        interpret();
        printf("ok\n");
    } else {
        if (quitting) {
            return errflag ? 2 : 0;
        }
        return 2;
    }
    fflush(stdout);
    return errflag ? 2 : 0;
}