Forp: Rewrite if/else/then in Forth
This commit is contained in:
parent
c0f19f7674
commit
769bb9e9aa
145
forp.c
145
forp.c
|
@ -44,6 +44,18 @@ void PUSHS(char *s) { stack->s = s; stack++; }
|
||||||
void RPUSH(cell c) { *rstack = c; rstack++; }
|
void RPUSH(cell c) { *rstack = c; rstack++; }
|
||||||
#define RPOP() (--rstack)
|
#define RPOP() (--rstack)
|
||||||
|
|
||||||
|
void f_here() {
|
||||||
|
PUSHCP(HERE);
|
||||||
|
}
|
||||||
|
|
||||||
|
void f_latest() {
|
||||||
|
PUSHCP(LATEST);
|
||||||
|
}
|
||||||
|
|
||||||
|
void f_state() {
|
||||||
|
PUSHC(STATE);
|
||||||
|
}
|
||||||
|
|
||||||
void f_add() {
|
void f_add() {
|
||||||
cell r = TOP();
|
cell r = TOP();
|
||||||
DROP(1);
|
DROP(1);
|
||||||
|
@ -64,6 +76,7 @@ void f_set() {
|
||||||
cell *p = TOP().p;
|
cell *p = TOP().p;
|
||||||
DROP(1);
|
DROP(1);
|
||||||
(*p) = TOP();
|
(*p) = TOP();
|
||||||
|
DROP(1);
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_drop() {
|
void f_drop() {
|
||||||
|
@ -75,10 +88,10 @@ void f_dup() {
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_swap() {
|
void f_swap() {
|
||||||
cell top = ST1();
|
cell top = TOP();
|
||||||
cell st1 = TOP();
|
cell st1 = ST1();
|
||||||
ST1() = st1;
|
TOP() = st1;
|
||||||
TOP() = top;
|
ST1() = top;
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_rot() { // a b c -- b c a
|
void f_rot() { // a b c -- b c a
|
||||||
|
@ -128,16 +141,24 @@ void f_emit() {
|
||||||
DROP(1);
|
DROP(1);
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_dot() {
|
void f_puts() {
|
||||||
printf("%d ", TOP().i);
|
char *s = TOP().s;
|
||||||
|
while (s && *s) {
|
||||||
|
PUSHI(*s);
|
||||||
|
f_emit();
|
||||||
|
s++;
|
||||||
|
}
|
||||||
DROP(1);
|
DROP(1);
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_puts() {
|
void f_dot() {
|
||||||
printf("%s", TOP().s);
|
static char num[16];
|
||||||
DROP(1);
|
sprintf(num, "%d ", TOP().i);
|
||||||
|
TOP().s = num;
|
||||||
|
f_puts();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
void f_cr() {
|
void f_cr() {
|
||||||
PUSHI('\n');
|
PUSHI('\n');
|
||||||
f_emit();
|
f_emit();
|
||||||
|
@ -189,7 +210,7 @@ void f_docolon() {
|
||||||
void f_noop() {
|
void f_noop() {
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_donumber() {
|
void f_push_() {
|
||||||
PUSHC(*IP.p);
|
PUSHC(*IP.p);
|
||||||
IP.p++;
|
IP.p++;
|
||||||
}
|
}
|
||||||
|
@ -225,6 +246,21 @@ void f_lookup() { // name -- (codepointer flags) | (name 0)
|
||||||
PUSHU(0);
|
PUSHU(0);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void f_revlookup() { // codepointer -- name
|
||||||
|
cell *entry = LATEST;
|
||||||
|
while (entry) {
|
||||||
|
unsigned int length = entry[1].u & ~F_IMMEDIATE;
|
||||||
|
cell *name = entry + 2;
|
||||||
|
cell *cp = CELL_OFFSET(name, length + 1);
|
||||||
|
if (cp == TOP().p) {
|
||||||
|
TOP().p = name;
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
entry = entry->p;
|
||||||
|
}
|
||||||
|
TOP().p = NULL;
|
||||||
|
}
|
||||||
|
|
||||||
void f_compileon() {
|
void f_compileon() {
|
||||||
STATE.i = 1;
|
STATE.i = 1;
|
||||||
}
|
}
|
||||||
|
@ -236,12 +272,11 @@ void f_immediate() {
|
||||||
cell *flags = LATEST + 1;
|
cell *flags = LATEST + 1;
|
||||||
flags->u |= F_IMMEDIATE;
|
flags->u |= F_IMMEDIATE;
|
||||||
}
|
}
|
||||||
|
void f_compileword();
|
||||||
|
|
||||||
void f_semicolon() {
|
void f_semicolon() {
|
||||||
PUSHS("_RET");
|
PUSHS("_RET");
|
||||||
f_lookup();
|
f_compileword();
|
||||||
DROP(1);
|
|
||||||
f_comma();
|
|
||||||
f_compileoff();
|
f_compileoff();
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -271,10 +306,8 @@ void f_interpretword() { // codefield flags --
|
||||||
|
|
||||||
void f_interpretnumber() { // number --
|
void f_interpretnumber() { // number --
|
||||||
if (STATE.i) {
|
if (STATE.i) {
|
||||||
PUSHS("_DONUMBER");
|
PUSHS("PUSH_");
|
||||||
f_lookup();
|
f_compileword();
|
||||||
DROP(1);
|
|
||||||
f_comma();
|
|
||||||
f_comma();
|
f_comma();
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
@ -325,37 +358,34 @@ void f_interpret(char *input) {
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_if() {
|
void f_if() {
|
||||||
if (STATE.i) {
|
PUSHS("IF_");
|
||||||
PUSHC(W);
|
f_compileword();
|
||||||
f_comma();
|
PUSHP(HERE);
|
||||||
PUSHP(HERE);
|
PUSHP(NULL);
|
||||||
PUSHP(NULL);
|
f_comma();
|
||||||
f_comma();
|
}
|
||||||
|
|
||||||
|
void f_if_() {
|
||||||
|
if (TOP().u) {
|
||||||
|
IP.p ++;
|
||||||
} else {
|
} else {
|
||||||
if (TOP().u) {
|
IP.p = IP.p->p; // skip to else or then
|
||||||
IP.p ++;
|
|
||||||
} else {
|
|
||||||
IP.p = IP.p->p; // skip to then
|
|
||||||
}
|
|
||||||
DROP(1);
|
|
||||||
}
|
}
|
||||||
|
DROP(1);
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_else() {
|
void f_else() {
|
||||||
if (STATE.i) {
|
PUSHS("GOTO_");
|
||||||
|
f_compileword();
|
||||||
|
PUSHP(NULL);
|
||||||
|
f_comma();
|
||||||
|
|
||||||
PUSHC(W);
|
TOP().p->p = HERE; // make false condition of IF come here
|
||||||
f_comma();
|
TOP().p = HERE - 1; // make THEN patch our goto
|
||||||
|
}
|
||||||
|
|
||||||
TOP().p->p = HERE + 1;
|
void f_goto_() {
|
||||||
TOP().p = HERE;
|
IP.p = IP.p->p;
|
||||||
|
|
||||||
PUSHP(NULL);
|
|
||||||
f_comma();
|
|
||||||
|
|
||||||
} else {
|
|
||||||
IP.p = IP.p->p;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_then() {
|
void f_then() {
|
||||||
|
@ -363,6 +393,17 @@ void f_then() {
|
||||||
DROP(1);
|
DROP(1);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void f_quote() {
|
||||||
|
if (STATE.i) {
|
||||||
|
PUSHS("PUSH_");
|
||||||
|
f_compileword();
|
||||||
|
} else {
|
||||||
|
f_word();
|
||||||
|
f_lookup();
|
||||||
|
DROP(1);
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
int DIE = 0;
|
int DIE = 0;
|
||||||
void f_quit() {
|
void f_quit() {
|
||||||
DIE = 1;
|
DIE = 1;
|
||||||
|
@ -372,31 +413,41 @@ void f_quit() {
|
||||||
void f_init() {
|
void f_init() {
|
||||||
CDEF("[", f_compileoff); f_immediate();
|
CDEF("[", f_compileoff); f_immediate();
|
||||||
CDEF("]", f_compileon);
|
CDEF("]", f_compileon);
|
||||||
|
CDEF("key", f_key);
|
||||||
|
CDEF("emit", f_emit);
|
||||||
|
CDEF("word", f_word);
|
||||||
CDEF("immediate", f_immediate);
|
CDEF("immediate", f_immediate);
|
||||||
CDEF("create", f_create);
|
CDEF("create", f_create);
|
||||||
|
CDEF("here", f_here);
|
||||||
|
CDEF("latest", f_latest);
|
||||||
|
CDEF("state", f_state);
|
||||||
|
CDEF("'", f_quote); f_immediate();
|
||||||
|
CDEF("`", f_revlookup);
|
||||||
CDEF(":", f_colon);
|
CDEF(":", f_colon);
|
||||||
CDEF(";", f_semicolon); f_immediate();
|
CDEF(";", f_semicolon); f_immediate();
|
||||||
CDEF("+", f_add);
|
CDEF("+", f_add);
|
||||||
CDEF("-", f_sub);
|
CDEF("-", f_sub);
|
||||||
CDEF("@", f_get);
|
CDEF("@", f_get);
|
||||||
CDEF("!", f_set);
|
CDEF("!", f_set);
|
||||||
CDEF("if", f_if); f_immediate();
|
|
||||||
CDEF("else", f_else); f_immediate();
|
|
||||||
CDEF("then", f_then); f_immediate();
|
|
||||||
CDEF("dup", f_dup);
|
CDEF("dup", f_dup);
|
||||||
CDEF("drop", f_drop);
|
CDEF("drop", f_drop);
|
||||||
CDEF("swap", f_drop);
|
CDEF("swap", f_swap);
|
||||||
CDEF("rot", f_rot);
|
CDEF("rot", f_rot);
|
||||||
CDEF("emit", f_emit);
|
CDEF("emit", f_emit);
|
||||||
CDEF("number", f_number);
|
CDEF("number", f_number);
|
||||||
CDEF("_DONUMBER", f_donumber);
|
CDEF("PUSH_", f_push_);
|
||||||
|
CDEF("GOTO_", f_goto_);
|
||||||
|
CDEF("IF_", f_if_);
|
||||||
CDEF("_RET", f_ret);
|
CDEF("_RET", f_ret);
|
||||||
CDEF(".", f_dot);
|
CDEF(".", f_dot);
|
||||||
CDEF(".s", f_puts);
|
CDEF(".s", f_puts);
|
||||||
CDEF(",", f_comma);
|
CDEF(",", f_comma);
|
||||||
CDEF("noop", f_noop);
|
CDEF("noop", f_noop);
|
||||||
CDEF("quit", f_quit);
|
CDEF("quit", f_quit);
|
||||||
f_interpret(": -rot rot rot ;");
|
f_interpret(": if ' IF_ , here 0 , ; immediate");
|
||||||
|
f_interpret(": else ' GOTO_ , 0 , here swap ! here 2 - ; immediate");
|
||||||
|
f_interpret(": then here swap ! ; immediate");
|
||||||
|
|
||||||
}
|
}
|
||||||
|
|
||||||
int main() {
|
int main() {
|
||||||
|
|
Loading…
Reference in a new issue