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

.gitignore

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

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 ;

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 f_add() {
+  void name() { \
-  cell r = TOP();
+    cell r = TOP(); \
-  DROP(1);
+    DROP(1); \
-  TOP().i += r.i;
+    TOP().i = TOP().i op r.i; \
   }
 
-void f_sub() {
+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() {
+  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) {
+void f_interpreter() {
-  INPUT = input;
   while(1) {
     f_word(); // w
     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();
 }
 
-void f_if_() {
+void f_bz_() {
-  if (TOP().u) {
+  if (!TOP().u) {
-    IP.p ++;
+    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() {
+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_() {
   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);
+    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_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()
@@ -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);
+  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() {
   char inputbuf[256];
   f_init();
+  CDEF("quit", f_quit);
 
   while (!DIE) {
-    f_interpret(gets(inputbuf));
+    f_runstring(gets(inputbuf));
   }
   return 0;
 }