Forp: Loading from file, strings, comments, math, byte ops
This commit is contained in:
parent
769bb9e9aa
commit
1a7d14b056
2
.gitignore
vendored
2
.gitignore
vendored
|
@ -2,3 +2,5 @@
|
||||||
*.bak
|
*.bak
|
||||||
*.dsk
|
*.dsk
|
||||||
*.swp
|
*.swp
|
||||||
|
*.log
|
||||||
|
|
||||||
|
|
31
defs.frp
Executable file
31
defs.frp
Executable file
|
@ -0,0 +1,31 @@
|
||||||
|
2 const cell
|
||||||
|
: cells cell * ;
|
||||||
|
|
||||||
|
key ) const ')'
|
||||||
|
|
||||||
|
10 const '\n'
|
||||||
|
key const sp
|
||||||
|
|
||||||
|
: cr '\n' emit ;
|
||||||
|
: bl sp emit ;
|
||||||
|
|
||||||
|
: if ' BZ_ , here 0 , ; immediate
|
||||||
|
: else ' GOTO_ , 0 , here swap ! here cell - ; immediate
|
||||||
|
: then here swap ! ; immediate
|
||||||
|
|
||||||
|
: begin here ; immediate
|
||||||
|
: while ' BZ_ , here 0 , ; immediate
|
||||||
|
: repeat ' GOTO_ , swap , here swap ! ; immediate
|
||||||
|
|
||||||
|
: ( begin key ')' != while repeat ; immediate
|
||||||
|
|
||||||
|
: 2dup over over ;
|
||||||
|
|
||||||
|
: decompile
|
||||||
|
word lookup drop 1 begin ( cp i )
|
||||||
|
2dup cells + @ ( cp i @cp+i )
|
||||||
|
dup ' _RET != ( cp i @cp+i bool )
|
||||||
|
while
|
||||||
|
dup ` dup if .s drop else drop . then bl ( cp i )
|
||||||
|
1 + ( cp i+1 )
|
||||||
|
repeat drop drop drop ;
|
259
forp.c
259
forp.c
|
@ -13,6 +13,7 @@ union cell_union {
|
||||||
cell *p;
|
cell *p;
|
||||||
char *s;
|
char *s;
|
||||||
void (*f)();
|
void (*f)();
|
||||||
|
FILE *fp;
|
||||||
};
|
};
|
||||||
|
|
||||||
char mem[MEM_SIZE];
|
char mem[MEM_SIZE];
|
||||||
|
@ -27,6 +28,10 @@ cell stack_mem[STACK_SIZE];
|
||||||
cell *stack = stack_mem;
|
cell *stack = stack_mem;
|
||||||
|
|
||||||
char *INPUT = NULL;
|
char *INPUT = NULL;
|
||||||
|
FILE *INPUT_FILE = NULL;
|
||||||
|
|
||||||
|
FILE *OUTPUT_FILE = NULL;
|
||||||
|
cell QUIET = 0;
|
||||||
|
|
||||||
#define F_IMMEDIATE 0x80
|
#define F_IMMEDIATE 0x80
|
||||||
|
|
||||||
|
@ -55,17 +60,29 @@ void f_latest() {
|
||||||
void f_state() {
|
void f_state() {
|
||||||
PUSHC(STATE);
|
PUSHC(STATE);
|
||||||
}
|
}
|
||||||
|
#define BINOP(name, op) \
|
||||||
|
void name() { \
|
||||||
|
cell r = TOP(); \
|
||||||
|
DROP(1); \
|
||||||
|
TOP().i = TOP().i op r.i; \
|
||||||
|
}
|
||||||
|
|
||||||
void f_add() {
|
BINOP(f_add, +)
|
||||||
cell r = TOP();
|
BINOP(f_sub, -)
|
||||||
DROP(1);
|
BINOP(f_mul, *)
|
||||||
TOP().i += r.i;
|
BINOP(f_div, /)
|
||||||
|
BINOP(f_eq, ==)
|
||||||
|
BINOP(f_neq, !=)
|
||||||
|
BINOP(f_ge, >=)
|
||||||
|
BINOP(f_gt, >)
|
||||||
|
BINOP(f_lt, <)
|
||||||
|
BINOP(f_le, <=)
|
||||||
|
|
||||||
|
void f_eq0() {
|
||||||
|
TOP().i = (TOP().i == 0);
|
||||||
}
|
}
|
||||||
|
void f_not() {
|
||||||
void f_sub() {
|
TOP().i = !TOP().i;
|
||||||
cell r = TOP();
|
|
||||||
DROP(1);
|
|
||||||
TOP().i -= r.i;
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_get() {
|
void f_get() {
|
||||||
|
@ -79,6 +96,17 @@ void f_set() {
|
||||||
DROP(1);
|
DROP(1);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void f_bget() {
|
||||||
|
TOP().i = *((char*)TOP().p);
|
||||||
|
}
|
||||||
|
|
||||||
|
void f_bset() {
|
||||||
|
char *p = (char*)TOP().p;
|
||||||
|
DROP(1);
|
||||||
|
(*p) = TOP().i;
|
||||||
|
DROP(1);
|
||||||
|
}
|
||||||
|
|
||||||
void f_drop() {
|
void f_drop() {
|
||||||
DROP(1);
|
DROP(1);
|
||||||
}
|
}
|
||||||
|
@ -87,6 +115,10 @@ void f_dup() {
|
||||||
PUSHC(TOP());
|
PUSHC(TOP());
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void f_over() {
|
||||||
|
PUSHC(ST1());
|
||||||
|
}
|
||||||
|
|
||||||
void f_swap() {
|
void f_swap() {
|
||||||
cell top = TOP();
|
cell top = TOP();
|
||||||
cell st1 = ST1();
|
cell st1 = ST1();
|
||||||
|
@ -110,9 +142,21 @@ void f_key() {
|
||||||
if (TOP().i == 0) {
|
if (TOP().i == 0) {
|
||||||
INPUT = NULL;
|
INPUT = NULL;
|
||||||
}
|
}
|
||||||
|
} else if (INPUT_FILE) {
|
||||||
|
int val = fgetc(INPUT_FILE);
|
||||||
|
if (val == EOF) {
|
||||||
|
fclose(INPUT_FILE);
|
||||||
|
INPUT_FILE = NULL;
|
||||||
|
PUSHI(0);
|
||||||
|
} else {
|
||||||
|
PUSHI(val);
|
||||||
|
}
|
||||||
} else {
|
} else {
|
||||||
PUSHI(0);
|
PUSHI(0);
|
||||||
}
|
}
|
||||||
|
if (OUTPUT_FILE && TOP().i != 0) {
|
||||||
|
fputc(TOP().i, OUTPUT_FILE);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_word() {
|
void f_word() {
|
||||||
|
@ -137,7 +181,12 @@ void f_word() {
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_emit() {
|
void f_emit() {
|
||||||
|
if (!QUIET.i) {
|
||||||
printf("%c", TOP().i);
|
printf("%c", TOP().i);
|
||||||
|
}
|
||||||
|
if (OUTPUT_FILE) {
|
||||||
|
fputc(TOP().i, OUTPUT_FILE);
|
||||||
|
}
|
||||||
DROP(1);
|
DROP(1);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -169,6 +218,12 @@ void f_comma() {
|
||||||
DROP(1);
|
DROP(1);
|
||||||
}
|
}
|
||||||
|
|
||||||
|
void f_bcomma() {
|
||||||
|
*((char*)HERE) = TOP().i;
|
||||||
|
HERE = CELL_OFFSET(HERE, 1);
|
||||||
|
DROP(1);
|
||||||
|
}
|
||||||
|
|
||||||
void f_create() { // name --
|
void f_create() { // name --
|
||||||
int namelen;
|
int namelen;
|
||||||
HERE->p = LATEST;
|
HERE->p = LATEST;
|
||||||
|
@ -206,11 +261,10 @@ void f_docolon() {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
|
|
||||||
void f_noop() {
|
void f_noop() {
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_push_() {
|
void f_lit_() {
|
||||||
PUSHC(*IP.p);
|
PUSHC(*IP.p);
|
||||||
IP.p++;
|
IP.p++;
|
||||||
}
|
}
|
||||||
|
@ -306,7 +360,7 @@ void f_interpretword() { // codefield flags --
|
||||||
|
|
||||||
void f_interpretnumber() { // number --
|
void f_interpretnumber() { // number --
|
||||||
if (STATE.i) {
|
if (STATE.i) {
|
||||||
PUSHS("PUSH_");
|
PUSHS("LIT_");
|
||||||
f_compileword();
|
f_compileword();
|
||||||
f_comma();
|
f_comma();
|
||||||
}
|
}
|
||||||
|
@ -337,8 +391,7 @@ void f_compileword() { // name --
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_interpret(char *input) {
|
void f_interpreter() {
|
||||||
INPUT = input;
|
|
||||||
while(1) {
|
while(1) {
|
||||||
f_word(); // w
|
f_word(); // w
|
||||||
if (TOP().s[0] == '\0') {
|
if (TOP().s[0] == '\0') {
|
||||||
|
@ -357,45 +410,113 @@ void f_interpret(char *input) {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_if() {
|
void f_open() {
|
||||||
PUSHS("IF_");
|
FILE *fp = fopen(TOP().s, "a+");
|
||||||
f_compileword();
|
fseek(fp, 0, SEEK_SET);
|
||||||
PUSHP(HERE);
|
TOP().fp = fp;
|
||||||
PUSHP(NULL);
|
}
|
||||||
|
|
||||||
|
void f_close() {
|
||||||
|
fclose(TOP().fp);
|
||||||
|
DROP(1);
|
||||||
|
}
|
||||||
|
|
||||||
|
void f__loadfile() {
|
||||||
|
INPUT_FILE = TOP().fp;
|
||||||
|
DROP(1);
|
||||||
|
f_interpreter();
|
||||||
|
if (INPUT_FILE != NULL) {
|
||||||
|
fclose(INPUT_FILE);
|
||||||
|
INPUT_FILE = NULL;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
void f_loadstring() {
|
||||||
|
INPUT = TOP().s;
|
||||||
|
DROP(1);
|
||||||
|
f_interpreter();
|
||||||
|
INPUT = NULL;
|
||||||
|
}
|
||||||
|
|
||||||
|
void f_appendlog() {
|
||||||
|
OUTPUT_FILE = TOP().fp;
|
||||||
|
fseek(OUTPUT_FILE, 0, SEEK_END);
|
||||||
|
DROP(1);
|
||||||
|
}
|
||||||
|
|
||||||
|
void f_doconst() {
|
||||||
|
PUSHC(*(W.p + 1));
|
||||||
|
}
|
||||||
|
|
||||||
|
void f_const() {
|
||||||
|
f_word();
|
||||||
|
f_create();
|
||||||
|
PUSHP(f_doconst);
|
||||||
|
f_comma();
|
||||||
f_comma();
|
f_comma();
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_if_() {
|
void f_bz_() {
|
||||||
if (TOP().u) {
|
if (!TOP().u) {
|
||||||
IP.p ++;
|
IP.p = IP.p->p; // branch
|
||||||
} else {
|
} else {
|
||||||
IP.p = IP.p->p; // skip to else or then
|
IP.p ++; // skip branch destination cell
|
||||||
}
|
}
|
||||||
DROP(1);
|
DROP(1);
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_else() {
|
void f_bnz_() {
|
||||||
PUSHS("GOTO_");
|
if (TOP().u) {
|
||||||
f_compileword();
|
IP.p = IP.p->p; // branch
|
||||||
PUSHP(NULL);
|
} else {
|
||||||
f_comma();
|
IP.p ++; // skip branch destination cell
|
||||||
|
}
|
||||||
TOP().p->p = HERE; // make false condition of IF come here
|
DROP(1);
|
||||||
TOP().p = HERE - 1; // make THEN patch our goto
|
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_goto_() {
|
void f_goto_() {
|
||||||
IP.p = IP.p->p;
|
IP.p = IP.p->p;
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_then() {
|
void f_string_() {
|
||||||
TOP().p->p = HERE;
|
PUSHP(IP.p + 1);
|
||||||
|
IP.p = CELL_OFFSET(IP.p + 1, IP.p->i + 1);
|
||||||
|
}
|
||||||
|
|
||||||
|
void f_string() {
|
||||||
|
cell *length;
|
||||||
|
char *s;
|
||||||
|
char b;
|
||||||
|
if (STATE.i) {
|
||||||
|
PUSHS("S\"_");
|
||||||
|
f_compileword();
|
||||||
|
length = HERE;
|
||||||
|
PUSHI(0);
|
||||||
|
f_comma();
|
||||||
|
}
|
||||||
|
s = (char*)HERE;
|
||||||
|
while(1) {
|
||||||
|
f_key();
|
||||||
|
b = TOP().i;
|
||||||
DROP(1);
|
DROP(1);
|
||||||
|
if (b == '\"') {
|
||||||
|
*s++ = 0;
|
||||||
|
break;
|
||||||
|
} else {
|
||||||
|
*s++ = b;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
if (STATE.i) {
|
||||||
|
length->i = (int)((s - ((char*)HERE)) - 1);
|
||||||
|
HERE = (cell *)s;
|
||||||
|
} else {
|
||||||
|
PUSHP(HERE);
|
||||||
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
void f_quote() {
|
void f_quote() {
|
||||||
if (STATE.i) {
|
if (STATE.i) {
|
||||||
PUSHS("PUSH_");
|
PUSHS("LIT_");
|
||||||
f_compileword();
|
f_compileword();
|
||||||
} else {
|
} else {
|
||||||
f_word();
|
f_word();
|
||||||
|
@ -404,9 +525,23 @@ void f_quote() {
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
int DIE = 0;
|
void f_loadfile(char *filename) {
|
||||||
void f_quit() {
|
PUSHS(filename);
|
||||||
DIE = 1;
|
f_open();
|
||||||
|
f__loadfile();
|
||||||
|
}
|
||||||
|
|
||||||
|
void f_runstring(char *s) {
|
||||||
|
PUSHS(s);
|
||||||
|
f_loadstring();
|
||||||
|
}
|
||||||
|
|
||||||
|
void f_quiet() {
|
||||||
|
QUIET.i = 1;
|
||||||
|
}
|
||||||
|
|
||||||
|
void f_loud() {
|
||||||
|
QUIET.i = 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
#define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef()
|
#define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef()
|
||||||
|
@ -423,39 +558,75 @@ void f_init() {
|
||||||
CDEF("state", f_state);
|
CDEF("state", f_state);
|
||||||
CDEF("'", f_quote); f_immediate();
|
CDEF("'", f_quote); f_immediate();
|
||||||
CDEF("`", f_revlookup);
|
CDEF("`", f_revlookup);
|
||||||
|
CDEF("lookup", f_lookup);
|
||||||
CDEF(":", f_colon);
|
CDEF(":", f_colon);
|
||||||
CDEF(";", f_semicolon); f_immediate();
|
CDEF(";", f_semicolon); f_immediate();
|
||||||
|
CDEF("const", f_const);
|
||||||
CDEF("+", f_add);
|
CDEF("+", f_add);
|
||||||
CDEF("-", f_sub);
|
CDEF("-", f_sub);
|
||||||
|
CDEF("*", f_mul);
|
||||||
|
CDEF("/", f_div);
|
||||||
|
CDEF("=0", f_eq0);
|
||||||
|
CDEF("not", f_not);
|
||||||
|
CDEF("=", f_eq);
|
||||||
|
CDEF("!=", f_neq);
|
||||||
|
CDEF(">=", f_ge);
|
||||||
|
CDEF(">", f_gt);
|
||||||
|
CDEF("=", f_eq);
|
||||||
|
CDEF("<", f_lt);
|
||||||
|
CDEF("<=", f_le);
|
||||||
CDEF("@", f_get);
|
CDEF("@", f_get);
|
||||||
CDEF("!", f_set);
|
CDEF("!", f_set);
|
||||||
|
CDEF("b@", f_bget);
|
||||||
|
CDEF("b!", f_bset);
|
||||||
CDEF("dup", f_dup);
|
CDEF("dup", f_dup);
|
||||||
|
CDEF("over", f_over);
|
||||||
CDEF("drop", f_drop);
|
CDEF("drop", f_drop);
|
||||||
CDEF("swap", f_swap);
|
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("PUSH_", f_push_);
|
CDEF("LIT_", f_lit_);
|
||||||
CDEF("GOTO_", f_goto_);
|
CDEF("GOTO_", f_goto_);
|
||||||
CDEF("IF_", f_if_);
|
CDEF("BZ_", f_bz_);
|
||||||
|
CDEF("BNZ_", f_bnz_);
|
||||||
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("b,", f_bcomma);
|
||||||
|
CDEF("s\"", f_string); f_immediate();
|
||||||
|
CDEF("S\"_", f_string_);
|
||||||
CDEF("noop", f_noop);
|
CDEF("noop", f_noop);
|
||||||
CDEF("quit", f_quit);
|
CDEF("open", f_open);
|
||||||
f_interpret(": if ' IF_ , here 0 , ; immediate");
|
CDEF("close", f_close);
|
||||||
f_interpret(": else ' GOTO_ , 0 , here swap ! here 2 - ; immediate");
|
CDEF("loadfile", f__loadfile);
|
||||||
f_interpret(": then here swap ! ; immediate");
|
CDEF("loadstring", f_loadstring);
|
||||||
|
CDEF("quiet", f_quiet);
|
||||||
|
CDEF("loud", f_loud);
|
||||||
|
CDEF("appendlog", f_appendlog);
|
||||||
|
|
||||||
|
|
||||||
|
PUSHS("forp.log");
|
||||||
|
f_open();
|
||||||
|
f_appendlog();
|
||||||
|
|
||||||
|
|
||||||
|
f_loadfile("defs.frp");
|
||||||
|
}
|
||||||
|
|
||||||
|
int DIE = 0;
|
||||||
|
void f_quit() {
|
||||||
|
DIE = 1;
|
||||||
}
|
}
|
||||||
|
|
||||||
int main() {
|
int main() {
|
||||||
char inputbuf[256];
|
char inputbuf[256];
|
||||||
f_init();
|
f_init();
|
||||||
|
CDEF("quit", f_quit);
|
||||||
|
|
||||||
while (!DIE) {
|
while (!DIE) {
|
||||||
f_interpret(gets(inputbuf));
|
f_runstring(gets(inputbuf));
|
||||||
}
|
}
|
||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
Loading…
Reference in a new issue