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
*.dsk
*.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;
char *s;
void (*f)();
FILE *fp;
};
char mem[MEM_SIZE];
@ -27,6 +28,10 @@ cell stack_mem[STACK_SIZE];
cell *stack = stack_mem;
char *INPUT = NULL;
FILE *INPUT_FILE = NULL;
FILE *OUTPUT_FILE = NULL;
cell QUIET = 0;
#define F_IMMEDIATE 0x80
@ -55,17 +60,29 @@ void f_latest() {
void f_state() {
PUSHC(STATE);
}
#define BINOP(name, op) \
void name() { \
cell r = TOP(); \
DROP(1); \
TOP().i = TOP().i op r.i; \
}
void f_add() {
cell r = TOP();
DROP(1);
TOP().i += r.i;
BINOP(f_add, +)
BINOP(f_sub, -)
BINOP(f_mul, *)
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_sub() {
cell r = TOP();
DROP(1);
TOP().i -= r.i;
void f_not() {
TOP().i = !TOP().i;
}
void f_get() {
@ -79,6 +96,17 @@ void f_set() {
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() {
DROP(1);
}
@ -87,6 +115,10 @@ void f_dup() {
PUSHC(TOP());
}
void f_over() {
PUSHC(ST1());
}
void f_swap() {
cell top = TOP();
cell st1 = ST1();
@ -110,9 +142,21 @@ void f_key() {
if (TOP().i == 0) {
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 {
PUSHI(0);
}
if (OUTPUT_FILE && TOP().i != 0) {
fputc(TOP().i, OUTPUT_FILE);
}
}
void f_word() {
@ -137,7 +181,12 @@ void f_word() {
}
void f_emit() {
if (!QUIET.i) {
printf("%c", TOP().i);
}
if (OUTPUT_FILE) {
fputc(TOP().i, OUTPUT_FILE);
}
DROP(1);
}
@ -169,6 +218,12 @@ void f_comma() {
DROP(1);
}
void f_bcomma() {
*((char*)HERE) = TOP().i;
HERE = CELL_OFFSET(HERE, 1);
DROP(1);
}
void f_create() { // name --
int namelen;
HERE->p = LATEST;
@ -206,11 +261,10 @@ void f_docolon() {
}
}
void f_noop() {
}
void f_push_() {
void f_lit_() {
PUSHC(*IP.p);
IP.p++;
}
@ -306,7 +360,7 @@ void f_interpretword() { // codefield flags --
void f_interpretnumber() { // number --
if (STATE.i) {
PUSHS("PUSH_");
PUSHS("LIT_");
f_compileword();
f_comma();
}
@ -337,8 +391,7 @@ void f_compileword() { // name --
}
}
void f_interpret(char *input) {
INPUT = input;
void f_interpreter() {
while(1) {
f_word(); // w
if (TOP().s[0] == '\0') {
@ -357,45 +410,113 @@ void f_interpret(char *input) {
}
}
void f_if() {
PUSHS("IF_");
f_compileword();
PUSHP(HERE);
PUSHP(NULL);
void f_open() {
FILE *fp = fopen(TOP().s, "a+");
fseek(fp, 0, SEEK_SET);
TOP().fp = fp;
}
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();
}
void f_if_() {
if (TOP().u) {
IP.p ++;
void f_bz_() {
if (!TOP().u) {
IP.p = IP.p->p; // branch
} else {
IP.p = IP.p->p; // skip to else or then
IP.p ++; // skip branch destination cell
}
DROP(1);
}
void f_else() {
PUSHS("GOTO_");
f_compileword();
PUSHP(NULL);
f_comma();
TOP().p->p = HERE; // make false condition of IF come here
TOP().p = HERE - 1; // make THEN patch our goto
void f_bnz_() {
if (TOP().u) {
IP.p = IP.p->p; // branch
} else {
IP.p ++; // skip branch destination cell
}
DROP(1);
}
void f_goto_() {
IP.p = IP.p->p;
}
void f_then() {
TOP().p->p = HERE;
void f_string_() {
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);
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() {
if (STATE.i) {
PUSHS("PUSH_");
PUSHS("LIT_");
f_compileword();
} else {
f_word();
@ -404,9 +525,23 @@ void f_quote() {
}
}
int DIE = 0;
void f_quit() {
DIE = 1;
void f_loadfile(char *filename) {
PUSHS(filename);
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()
@ -423,39 +558,75 @@ void f_init() {
CDEF("state", f_state);
CDEF("'", f_quote); f_immediate();
CDEF("`", f_revlookup);
CDEF("lookup", f_lookup);
CDEF(":", f_colon);
CDEF(";", f_semicolon); f_immediate();
CDEF("const", f_const);
CDEF("+", f_add);
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_set);
CDEF("b@", f_bget);
CDEF("b!", f_bset);
CDEF("dup", f_dup);
CDEF("over", f_over);
CDEF("drop", f_drop);
CDEF("swap", f_swap);
CDEF("rot", f_rot);
CDEF("emit", f_emit);
CDEF("number", f_number);
CDEF("PUSH_", f_push_);
CDEF("LIT_", f_lit_);
CDEF("GOTO_", f_goto_);
CDEF("IF_", f_if_);
CDEF("BZ_", f_bz_);
CDEF("BNZ_", f_bnz_);
CDEF("_RET", f_ret);
CDEF(".", f_dot);
CDEF(".s", f_puts);
CDEF(",", f_comma);
CDEF("b,", f_bcomma);
CDEF("s\"", f_string); f_immediate();
CDEF("S\"_", f_string_);
CDEF("noop", f_noop);
CDEF("quit", f_quit);
f_interpret(": if ' IF_ , here 0 , ; immediate");
f_interpret(": else ' GOTO_ , 0 , here swap ! here 2 - ; immediate");
f_interpret(": then here swap ! ; immediate");
CDEF("open", f_open);
CDEF("close", f_close);
CDEF("loadfile", f__loadfile);
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() {
char inputbuf[256];
f_init();
CDEF("quit", f_quit);
while (!DIE) {
f_interpret(gets(inputbuf));
f_runstring(gets(inputbuf));
}
return 0;
}

BIN
forp.exe

Binary file not shown.