diff options
Diffstat (limited to 'foci.c')
| -rw-r--r-- | foci.c | 55 |
1 files changed, 33 insertions, 22 deletions
@@ -35,7 +35,6 @@ NAKED void push(void) { *--sp = (intptr_t)*++pp; NEXT; } NAKED void fexit(void) { pp = *rp++; NEXT; } void fend(void) {} -static const void * const fend_b[2] = { 0, fend }; NAKED void compname(void) { @@ -102,7 +101,9 @@ N(mrot, "-rot", &w_rot) { tmp = sp[2]; sp[2] = sp[0]; sp[0] = sp[1]; sp[1] = tmp; NEXT; } N(over, "over", &w_mrot) { --sp; sp[0] = sp[2]; NEXT; } W(tuck, "tuck", &w_over) swap, over, END -N(peek, "@", &w_tuck) { *sp = *(intptr_t *)*sp; NEXT; } +W(drop2, "2drop", &w_tuck) drop, drop, END +W(dup2, "2dup", &w_drop2) over, over, END +N(peek, "@", &w_dup2) { *sp = *(intptr_t *)*sp; NEXT; } N(poke, "!", &w_peek) { *(intptr_t *)sp[0] = sp[1]; sp += 2; NEXT; } N(cpeek, "c@", &w_poke) { *sp = *(char *)*sp; NEXT; } N(cpoke, "c!", &w_cpeek) { *(char *)sp[0] = (char)sp[1]; sp += 2; NEXT; } @@ -117,24 +118,32 @@ N(or, "or", &w_and) { sp[1] |= sp[0]; ++sp; NEXT; } N(xor, "xor", &w_or) { sp[1] ^= sp[0]; ++sp; NEXT; } N(eq, "=", &w_xor) { sp[1] = sp[0] == sp[1] ? -1 : 0; ++sp; NEXT; } N(lt, "<", &w_eq) { sp[1] = sp[0] > sp[1] ? -1 : 0; ++sp; NEXT; } -N(compname, "_c", &w_lt) ; +W(gt, ">", &w_lt) swap, lt, END +W(zeq, "0=", &w_gt) LIT(0), eq, END +W(zlt, "0<", &w_zeq) LIT(0), lt, END +N(compname, "_c", &w_zlt) ; C(intr, "[", &w_compname) { STATE = 0; NEXT; } N(comp, "]", &w_intr) { STATE = -1; NEXT; } N(comma, ",", &w_comp) { *here++ = *sp++; NEXT; } W(cell, "cell", &w_comma) LIT(sizeof(*sp)), END W(cellp, "cell+", &w_cell) FTH(cell), add, END W(cells, "cells", &w_cellp) FTH(cell), mul, END -N(dict, "_d", &w_cells) { *--sp = (intptr_t)dictmem; NEXT; } -W(base, "base", &w_dict) LIT(&BASE), END +W(charp, "char+", &w_cells) LIT(1), add, END +W(chars, "chars", &w_charp) END +W(base, "base", &w_chars) LIT(&BASE), END W(here, "here", &w_base) LIT(&here), peek, END W(allot, "allot", &w_here) LIT(&here), FTH(addto), END -W(latest, "latest", &w_allot) LIT(&LATEST), peek, END +W(ccomma, "c,", &w_allot) FTH(here), cpoke, LIT(1), FTH(allot), END +W(latest, "latest", &w_ccomma) LIT(&LATEST), peek, END W(negate, "negate", &w_latest) LIT(-1), mul, END W(invert, "invert", &w_negate) LIT(-1), xor, END -W(dec, "1-", &w_invert) LIT(1), sub, END -W(inc, "1+", &w_dec) LIT(1), add, END -W(aligned, "aligned", &w_inc) LIT(sizeof(*sp) - 1), add, LIT(~(sizeof(*sp) - 1)), - and, END +W(dec, "1-", &w_invert) LIT(1), sub, END +W(inc, "1+", &w_dec) LIT(1), add, END +W(twot, "2*", &w_inc) LIT(2), mul, END +W(peek2, "2@", &w_twot) dup, FTH(cellp), peek, swap, peek, END +W(poke2, "2!", &w_peek2) swap, over, poke, FTH(cellp), poke, END +W(aligned, "aligned", &w_poke2) LIT(sizeof(*sp) - 1), add, LIT(~(sizeof(*sp) - 1)), + and, END W(align, "align", &w_aligned) FTH(here), FTH(aligned), LIT(&here), poke, END W(colon, ":", &w_align) FTH(here), LIT(0), comma, FTH(latest), comma, compname, FTH(allot), FTH(align), dup, @@ -149,11 +158,16 @@ I(felse, "else", &w_then) LIT(b), comma, FTH(here), LIT(0), comma, swap, F W(tick, "\'", &w_felse) compname, drop, lookup, peek, END I(ctick, "[\']", &w_tick) FTH(tick), FTH(literal), END N(execute, "execute", &w_ctick) { pp = (intptr_t **)*sp++ - 1; NEXT; } -W(decimal, "decimal", &w_execute) LIT(10), LIT(&BASE), poke, END +N(recurse, "recurse", &w_execute) { pp = (intptr_t **)**rp - 1; NEXT; } +W(decimal, "decimal", &w_recurse) LIT(10), LIT(&BASE), poke, END W(hex, "hex", &w_decimal) LIT(16), LIT(&BASE), poke, END N(dot, ".", &w_hex) ; N(emit, "emit", &w_dot) { foci_putchar(*sp++); NEXT; } -I(begin, "begin", &w_emit) FTH(here), LIT(sizeof(intptr_t)), sub, END +W(bl, "bl", &w_emit) LIT(' '), END +W(space, "space", &w_bl) LIT(' '), emit, END +W(cr, "cr", &w_space) LIT('\n'), emit, END +N(depth, "depth", &w_cr) { *--sp = foci_depth(); NEXT; } +I(begin, "begin", &w_depth) FTH(here), LIT(sizeof(intptr_t)), sub, END I(until, "until", &w_begin) LIT(bz), comma, comma, END I(again, "again", &w_until) LIT(b), comma, comma, END I(fwhile, "while", &w_again) FTH(fif), END @@ -179,18 +193,20 @@ I(loop, "loop", &w_fdo) LIT(popr), comma, LIT(popr2), comma, LIT(drop), comma, LIT(drop), comma, END W(immediate, "immediate", &w_loop) FTH(latest), LIT(2 * sizeof(intptr_t)), add, - LIT(ATTR_IMMEDIATE), over, cpeek, or, swap, cpoke, END + dup, cpeek, LIT(ATTR_IMMEDIATE), or, swap, cpoke, END // Be sure to update LATEST_INIT in foci.h! static void enter_forth(void *ptr) { + static intptr_t *run[3] = {(intptr_t *)enter, 0, (intptr_t *)fend}; + run[1] = (intptr_t *)ptr; + STASH; sp = saved_sp; rp = saved_rp; - pp = ptr; + pp = run; - *--rp = (intptr_t **)fend_b; - ((void (*)())*pp)(); + enter(); saved_sp = sp; saved_rp = rp; @@ -318,16 +334,11 @@ void init(intptr_t *dictmemm) saved_rp = END_OF(rstack); } -int depth(void) +int foci_depth(void) { return END_OF(dstack) - saved_sp; } -int rdepth(void) -{ - return END_OF(rstack) - saved_rp; -} - int compiling(void) { return STATE; |