diff --git a/.gitignore b/.gitignore index d0dad88..91587d6 100644 --- a/.gitignore +++ b/.gitignore @@ -2,3 +2,5 @@ *.bak *.dsk *.swp +*.log + diff --git a/defs.frp b/defs.frp new file mode 100755 index 0000000..aa44704 --- /dev/null +++ b/defs.frp @@ -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 ; diff --git a/forp.c b/forp.c index 1f4ab57..1aca100 100755 --- a/forp.c +++ b/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; } \ No newline at end of file diff --git a/forp.exe b/forp.exe index 37caadb..577e287 100755 Binary files a/forp.exe and b/forp.exe differ