|
|
|
@ -23,8 +23,21 @@
|
|
|
|
|
#define END EXIT, };
|
|
|
|
|
|
|
|
|
|
#define W(name, tname, prev) WORD(name, tname, prev, 0)
|
|
|
|
|
#define N(name, tname, prev) WORD(name, tname, prev, ATTR_NATIVE)
|
|
|
|
|
#define I(name, tname, prev) WORD(name, tname, prev, ATTR_IMMEDIATE)
|
|
|
|
|
#define N(name, tname, prev) \
|
|
|
|
|
extern const void *name##_body[]; \
|
|
|
|
|
struct word_t w_##name = { \
|
|
|
|
|
name##_body, prev, \
|
|
|
|
|
ATTR_NATIVE + sizeof(tname) - 1, tname \
|
|
|
|
|
}; \
|
|
|
|
|
const void *name##_body[] = { name, EXIT };
|
|
|
|
|
#define C(name, tname, prev) \
|
|
|
|
|
extern const void *name##_body[]; \
|
|
|
|
|
struct word_t w_##name = { \
|
|
|
|
|
name##_body, prev, \
|
|
|
|
|
(ATTR_NATIVE | ATTR_IMMEDIATE) + sizeof(tname) - 1, tname \
|
|
|
|
|
}; \
|
|
|
|
|
const void *name##_body[] = { name, EXIT };
|
|
|
|
|
|
|
|
|
|
struct word_t
|
|
|
|
|
{
|
|
|
|
@ -56,8 +69,8 @@ void push()
|
|
|
|
|
NAKED
|
|
|
|
|
void sp_at()
|
|
|
|
|
{
|
|
|
|
|
*sp = (intptr_t)sp;
|
|
|
|
|
sp = sp - 1;
|
|
|
|
|
*sp = (intptr_t)(sp + 1);
|
|
|
|
|
NEXT;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
@ -128,40 +141,54 @@ NAKED void colon()
|
|
|
|
|
}
|
|
|
|
|
RESTORE;
|
|
|
|
|
|
|
|
|
|
here += *(unsigned char *)here;
|
|
|
|
|
here = (intptr_t *)(((intptr_t)here + sizeof(intptr_t) - 1)
|
|
|
|
|
& ~(sizeof(intptr_t) - 1));
|
|
|
|
|
*(intptr_t *)tmp = (intptr_t)here;
|
|
|
|
|
*--sp = tmp;
|
|
|
|
|
state = -1;
|
|
|
|
|
NEXT;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
NAKED void semic()
|
|
|
|
|
{
|
|
|
|
|
extern struct word_t *latest;
|
|
|
|
|
|
|
|
|
|
*here++ = (intptr_t)doexit;
|
|
|
|
|
latest = (struct word_t *)*sp++;
|
|
|
|
|
state = 0;
|
|
|
|
|
NEXT;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
//W(two, "2", &w_dup) LIT(2), FTH(dup), END
|
|
|
|
|
|
|
|
|
|
W(dup, "dup", 0) sp_at, peek, END
|
|
|
|
|
W(drop, "drop", &w_dup) drop, END
|
|
|
|
|
W(swap, "swap", &w_drop) swap, END
|
|
|
|
|
W(peek, "@", &w_swap) peek, END
|
|
|
|
|
W(poke, "!", &w_peek) poke, END
|
|
|
|
|
W(cpeek, "c@", &w_poke) cpeek, END
|
|
|
|
|
W(cpoke, "c!", &w_cpeek) cpoke, END
|
|
|
|
|
W(add, "+", &w_cpoke) add, END
|
|
|
|
|
W(sub, "-", &w_add) sub, END
|
|
|
|
|
W(mul, "*", &w_sub) mul, END
|
|
|
|
|
W(div, "/", &w_mul) div, END
|
|
|
|
|
W(mod, "mod", &w_div) mod, END
|
|
|
|
|
W(and, "and", &w_mod) and, END
|
|
|
|
|
W(or, "or", &w_and) or, END
|
|
|
|
|
W(xor, "xor", &w_or) xor, END
|
|
|
|
|
W(cell, "cell", &w_xor) cell, END
|
|
|
|
|
N(drop, "drop", &w_dup)
|
|
|
|
|
N(swap, "swap", &w_drop)
|
|
|
|
|
N(peek, "@", &w_swap)
|
|
|
|
|
N(poke, "!", &w_peek)
|
|
|
|
|
N(cpeek, "c@", &w_poke)
|
|
|
|
|
N(cpoke, "c!", &w_cpeek)
|
|
|
|
|
N(add, "+", &w_cpoke)
|
|
|
|
|
N(sub, "-", &w_add)
|
|
|
|
|
N(mul, "*", &w_sub)
|
|
|
|
|
N(div, "/", &w_mul)
|
|
|
|
|
N(mod, "mod", &w_div)
|
|
|
|
|
N(and, "and", &w_mod)
|
|
|
|
|
N(or, "or", &w_and)
|
|
|
|
|
N(xor, "xor", &w_or)
|
|
|
|
|
N(cell, "cell", &w_xor)
|
|
|
|
|
W(cellp, "cell+", &w_cell) cell, add, END
|
|
|
|
|
W(cells, "cells", &w_cellp) cell, mul, END
|
|
|
|
|
W(dict, "_d", &w_cells) LIT(dict), END
|
|
|
|
|
W(here, "here", &w_dict) LIT(&here), peek, END
|
|
|
|
|
I(intr, "[", &w_here) intr, END
|
|
|
|
|
W(comp, "]", &w_intr) comp, END
|
|
|
|
|
W(dot, ".", &w_comp) dot, END
|
|
|
|
|
W(colon, ":", &w_dot) colon, END
|
|
|
|
|
W(align, "align", &w_colon) align, END
|
|
|
|
|
W(comma, ",", &w_align) comma, END
|
|
|
|
|
C(intr, "[", &w_here)
|
|
|
|
|
N(comp, "]", &w_intr)
|
|
|
|
|
N(dot, ".", &w_comp)
|
|
|
|
|
N(colon, ":", &w_dot)
|
|
|
|
|
C(semic, ";", &w_colon)
|
|
|
|
|
N(align, "align", &w_semic)
|
|
|
|
|
N(comma, ",", &w_align)
|
|
|
|
|
struct word_t *latest = &w_comma;
|
|
|
|
|
|
|
|
|
|
void init()
|
|
|
|
@ -260,7 +287,12 @@ int main()
|
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
if (state && !(l->attr & ATTR_IMMEDIATE)) {
|
|
|
|
|
*here++ = (intptr_t)l->body;
|
|
|
|
|
if (!(l->attr & ATTR_NATIVE)) {
|
|
|
|
|
*here++ = (intptr_t)enter;
|
|
|
|
|
*here++ = (intptr_t)l->body;
|
|
|
|
|
} else {
|
|
|
|
|
*here++ = (intptr_t)l->body[0];
|
|
|
|
|
}
|
|
|
|
|
} else {
|
|
|
|
|
call(l->body);
|
|
|
|
|
}
|
|
|
|
|