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
|
||||
*.dsk
|
||||
*.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 ;
|
||||
263
forp.c
263
forp.c
|
|
@ -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() {
|
||||
printf("%c", TOP().i);
|
||||
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;
|
||||
DROP(1);
|
||||
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;
|
||||
}
|
||||
Loading…
Reference in a new issue