Initial Forth interpreter implementation (Forp)
This commit is contained in:
parent
56fac17626
commit
b9fec53c09
340
forp.c
Executable file
340
forp.c
Executable file
|
@ -0,0 +1,340 @@
|
|||
#include <stdio.h>
|
||||
|
||||
#define MEM_SIZE 16384
|
||||
#define STACK_SIZE 64
|
||||
#define RSTACK_SIZE 32
|
||||
|
||||
union cell_union;
|
||||
typedef union cell_union cell;
|
||||
|
||||
union cell_union {
|
||||
int i;
|
||||
unsigned int u;
|
||||
cell *p;
|
||||
char *s;
|
||||
void (*f)();
|
||||
};
|
||||
|
||||
char mem[MEM_SIZE];
|
||||
cell *HERE = (cell*)mem;
|
||||
cell *LATEST = NULL;
|
||||
cell IP = NULL;
|
||||
cell W = NULL;
|
||||
cell STATE = 0;
|
||||
cell rstack_mem[RSTACK_SIZE];
|
||||
cell *rstack = rstack_mem;
|
||||
cell stack_mem[STACK_SIZE];
|
||||
cell *stack = stack_mem;
|
||||
|
||||
char *INPUT = NULL;
|
||||
|
||||
#define CELL_OFFSET(cp, b) ((cell*)(((char *)(cp)) + b))
|
||||
#define TOP() (*(stack - 1))
|
||||
#define ST1() (*(stack - 2))
|
||||
#define ST2() (*(stack - 3))
|
||||
#define DROP(n) (stack -= n)
|
||||
void PUSHC(cell c) { *stack = c; stack++; }
|
||||
void PUSHI(int i) { stack->i = i; stack++; }
|
||||
void PUSHU(unsigned int u) { stack->u = u; stack++; }
|
||||
void PUSHCP(cell *c) { stack->p = c; stack++; }
|
||||
#define PUSHP(p) PUSHCP((cell*)p)
|
||||
void PUSHS(char *s) { stack->s = s; stack++; }
|
||||
void RPUSH(cell c) { *rstack = c; rstack++; }
|
||||
#define RPOP() (--rstack)
|
||||
|
||||
void f_add() {
|
||||
cell r = TOP();
|
||||
DROP(1);
|
||||
TOP().i += r.i;
|
||||
}
|
||||
|
||||
void f_sub() {
|
||||
cell r = TOP();
|
||||
DROP(1);
|
||||
TOP().i -= r.i;
|
||||
}
|
||||
|
||||
void f_get() {
|
||||
TOP() = (*(TOP().p));
|
||||
}
|
||||
|
||||
void f_set() {
|
||||
cell *p = TOP().p;
|
||||
DROP(1);
|
||||
(*p) = TOP();
|
||||
}
|
||||
|
||||
void f_drop() {
|
||||
DROP(1);
|
||||
}
|
||||
|
||||
void f_dup() {
|
||||
PUSHC(TOP());
|
||||
}
|
||||
|
||||
void f_swap() {
|
||||
cell top = ST1();
|
||||
cell st1 = TOP();
|
||||
ST1() = st1;
|
||||
TOP() = top;
|
||||
}
|
||||
|
||||
void f_rot() { // a b c -- b c a
|
||||
cell c = TOP();
|
||||
cell b = ST1();
|
||||
cell a = ST2();
|
||||
TOP() = a;
|
||||
ST1() = c;
|
||||
ST2() = b;
|
||||
}
|
||||
|
||||
|
||||
void f_key() {
|
||||
if (INPUT) {
|
||||
PUSHI(*INPUT);
|
||||
INPUT++;
|
||||
if (TOP().i == 0) {
|
||||
INPUT = NULL;
|
||||
}
|
||||
} else {
|
||||
PUSHI(0);
|
||||
}
|
||||
}
|
||||
|
||||
void f_word() {
|
||||
static char buf[32] = {0};
|
||||
int key = ' ';
|
||||
int ibuf = 0;
|
||||
|
||||
while (key == ' ' || key == '\n' || key == '\r') {
|
||||
f_key();
|
||||
key = TOP().i;
|
||||
DROP(1);
|
||||
}
|
||||
|
||||
while (key != ' ' && key != '\n' && key != '\r' && key != 0) {
|
||||
buf[ibuf++] = key;
|
||||
f_key();
|
||||
key = TOP().i;
|
||||
DROP(1);
|
||||
}
|
||||
buf[ibuf] = 0;
|
||||
PUSHS(buf);
|
||||
}
|
||||
|
||||
void f_emit() {
|
||||
printf("%c", TOP().i);
|
||||
DROP(1);
|
||||
}
|
||||
|
||||
void f_dot() {
|
||||
printf("%d ", TOP().i);
|
||||
DROP(1);
|
||||
}
|
||||
|
||||
void f_puts() {
|
||||
printf("%s", TOP().s);
|
||||
DROP(1);
|
||||
}
|
||||
|
||||
void f_cr() {
|
||||
PUSHI('\n');
|
||||
f_emit();
|
||||
}
|
||||
|
||||
void f_comma() {
|
||||
*HERE++ = TOP();
|
||||
DROP(1);
|
||||
}
|
||||
|
||||
void f_create() { // name --
|
||||
int namelen;
|
||||
HERE->p = LATEST;
|
||||
LATEST = HERE;
|
||||
HERE++;
|
||||
namelen = strlen(TOP().s);
|
||||
HERE->u = namelen; HERE ++;
|
||||
memcpy(HERE, TOP().s, namelen + 1);
|
||||
HERE = CELL_OFFSET(HERE, namelen + 1);
|
||||
DROP(1);
|
||||
}
|
||||
|
||||
void f_cdef() { // func name --
|
||||
f_create();
|
||||
HERE->p = TOP().p;
|
||||
HERE ++;
|
||||
DROP(1);
|
||||
}
|
||||
|
||||
|
||||
int RET = 0;
|
||||
void f_docolon() {
|
||||
RPUSH(IP);
|
||||
IP.p = W.p + 1;
|
||||
|
||||
while (!RET) {
|
||||
W = *IP.p;
|
||||
IP.p++;
|
||||
W.p->f();
|
||||
}
|
||||
RET = 0;
|
||||
IP = *RPOP();
|
||||
}
|
||||
|
||||
void f_ret() {
|
||||
RET = 1;
|
||||
}
|
||||
|
||||
void f_donumber() {
|
||||
PUSHC(*IP.p);
|
||||
IP.p++;
|
||||
}
|
||||
|
||||
void f_number() { // str -- num isnum
|
||||
int num = 0, result;
|
||||
result = sscanf(TOP().s, "%d", &num);
|
||||
TOP().i = num;
|
||||
PUSHI(result == 1);
|
||||
}
|
||||
|
||||
void f_streq() {
|
||||
int result = strcmp(TOP().s, ST1().s);
|
||||
DROP(1);
|
||||
TOP().i = result == 0;
|
||||
}
|
||||
|
||||
void f_lookup() { // name -- code pointer
|
||||
cell *entry = LATEST;
|
||||
while (entry) {
|
||||
f_dup();
|
||||
PUSHP(entry + 2);
|
||||
f_streq();
|
||||
if (TOP().i) {
|
||||
DROP(1);
|
||||
TOP().p = CELL_OFFSET(entry + 2, entry[1].u + 1);
|
||||
return;
|
||||
}
|
||||
DROP(1);
|
||||
entry = entry->p;
|
||||
}
|
||||
TOP().p = NULL;
|
||||
}
|
||||
|
||||
void f_def() {
|
||||
cell *herebefore = HERE;
|
||||
cell *latestbefore = LATEST;
|
||||
f_word();
|
||||
f_create();
|
||||
PUSHP(f_docolon);
|
||||
f_comma();
|
||||
while(1) {
|
||||
f_word(); // w
|
||||
f_dup(); // w w
|
||||
f_lookup(); // w code
|
||||
if (TOP().p == NULL) {
|
||||
DROP(1); // w
|
||||
f_dup(); // w w
|
||||
f_number(); // w n isnum
|
||||
if (TOP().i) {
|
||||
PUSHS("_DONUMBER");
|
||||
f_lookup(); // w n isnum _donumber
|
||||
f_comma();
|
||||
PUSHI(ST1().i); // w n isnum n
|
||||
f_comma(); // w n isnum
|
||||
DROP(3);
|
||||
} else {
|
||||
DROP(2); // w
|
||||
HERE = herebefore;
|
||||
LATEST = latestbefore;
|
||||
f_puts();
|
||||
PUSHS("?\n");
|
||||
f_puts();
|
||||
f_cr();
|
||||
return;
|
||||
}
|
||||
} else if (TOP().p->f == f_ret) {
|
||||
f_comma();
|
||||
DROP(1);
|
||||
return;
|
||||
} else {
|
||||
f_comma();
|
||||
DROP(1);
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
void f_interpret(char *input) {
|
||||
INPUT = input;
|
||||
while(1) {
|
||||
f_word(); // w
|
||||
if (TOP().s[0] == '\0') {
|
||||
PUSHS("ok\n");
|
||||
f_puts();
|
||||
DROP(1);
|
||||
return;
|
||||
}
|
||||
f_dup(); // w w
|
||||
f_lookup(); // w code
|
||||
if (TOP().p == NULL) {
|
||||
DROP(1); // w
|
||||
f_dup(); // w w
|
||||
f_number(); // w n isnum
|
||||
if (TOP().i) {
|
||||
f_rot(); // w n isnum -- n isnum w
|
||||
DROP(2); // n isnum w -- n
|
||||
continue;
|
||||
}
|
||||
DROP(2); // w
|
||||
f_puts();
|
||||
PUSHS("?\n");
|
||||
f_puts();
|
||||
return;
|
||||
}
|
||||
W = TOP(); // w code
|
||||
DROP(2);
|
||||
W.p->f();
|
||||
if (stack < stack_mem) {
|
||||
stack = stack_mem;
|
||||
PUSHS("stack underflow!\n");
|
||||
f_puts();
|
||||
return;
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
int DIE = 0;
|
||||
void f_quit() {
|
||||
DIE = 1;
|
||||
}
|
||||
|
||||
#define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef()
|
||||
void f_init() {
|
||||
CDEF(":", f_def);
|
||||
CDEF(";", f_ret);
|
||||
CDEF("+", f_add);
|
||||
CDEF("-", f_sub);
|
||||
CDEF("@", f_get);
|
||||
CDEF("!", f_set);
|
||||
CDEF("dup", f_dup);
|
||||
CDEF("drop", f_drop);
|
||||
CDEF("swap", f_drop);
|
||||
CDEF("rot", f_rot);
|
||||
CDEF("emit", f_emit);
|
||||
CDEF("number", f_number);
|
||||
CDEF("_DONUMBER", f_donumber);
|
||||
CDEF(".", f_dot);
|
||||
CDEF(".s", f_puts);
|
||||
CDEF(",", f_comma);
|
||||
CDEF("quit", f_quit);
|
||||
f_interpret(": -rot rot rot ;");
|
||||
}
|
||||
|
||||
int main() {
|
||||
char inputbuf[256];
|
||||
f_init();
|
||||
|
||||
while (!DIE) {
|
||||
f_interpret(gets(inputbuf));
|
||||
}
|
||||
return 0;
|
||||
}
|
Loading…
Reference in a new issue