Forp: Loading from file, strings, comments, math, byte ops

This commit is contained in:
Jeremy Penner 2019-02-02 15:30:18 -05:00
parent 769bb9e9aa
commit 1a7d14b056
4 changed files with 250 additions and 46 deletions

2
.gitignore vendored
View file

@ -2,3 +2,5 @@
*.bak *.bak
*.dsk *.dsk
*.swp *.swp
*.log

31
defs.frp Executable file
View 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
View file

@ -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;
} }

BIN
forp.exe

Binary file not shown.