From 0dc6719cc199e1f370f720f567b1fb0c82a6baf2 Mon Sep 17 00:00:00 2001
From: Brad Nelson <flagxor@gmail.com>
Date: Sun, 3 Jan 2021 21:16:36 -0800
Subject: [PATCH] eval -> evaluate, better errors.

---
 ueforth/common/boot.fs   | 21 +++++++++++++--------
 ueforth/common/core.h    | 22 ++++++++++++++++------
 ueforth/common/opcodes.h |  6 +++---
 3 files changed, 32 insertions(+), 17 deletions(-)

diff --git a/ueforth/common/boot.fs b/ueforth/common/boot.fs
index 5726511..3a24751 100644
--- a/ueforth/common/boot.fs
+++ b/ueforth/common/boot.fs
@@ -37,7 +37,7 @@
 : base ( -- a ) 'sys 4 cells + ;
 : 'heap ( -- a ) 'sys 5 cells + ;
 : last ( -- a ) 'sys 6 cells + ;
-: 'throw ( -- a ) 'sys 7 cells + ;
+: 'notfound ( -- a ) 'sys 7 cells + ;
 
 ( Dictionary )
 : here ( -- a ) 'heap @ ;
@@ -52,7 +52,7 @@
 : ] -1 state ! ; immediate
 
 ( Quoting Words )
-: ' bl parse find dup 0= 'throw @ execute ;
+: ' bl parse 2dup find dup >r -rot r> 0= 'notfound @ execute 2drop ;
 : ['] ' aliteral ; immediate
 : char bl parse drop c@ ;
 : [char] char aliteral ; immediate
@@ -114,7 +114,7 @@ variable handler
   sp@ >r handler @ >r rp@ handler ! execute r> handler ! r> drop 0 ;
 : throw ( n -- )
   dup if handler @ rp! r> handler !  r> swap >r sp! drop r> else drop then ;
-' throw 'throw !
+' throw 'notfound !
 
 ( Values )
 : value ( n -- ) create , does> @ ;
@@ -159,6 +159,11 @@ variable hld
 : ."   postpone s" state @ if postpone type else type then ; immediate
 : z"   postpone s" state @ if postpone drop else drop then ; immediate
 
+( Better Errors )
+: notfound ( a n n -- )
+   if cr ." ERROR: " type ."  NOT FOUND!" cr -1 throw then ;
+' notfound 'notfound !
+
 ( Examine Dictionary )
 : see. ( xt -- ) >name type space ;
 : see-one ( xt -- xt+1 )
@@ -180,10 +185,10 @@ create input-buffer   input-limit allot
 
 ( REPL )
 : prompt   ."  ok" cr ;
-: eval-buffer   begin >in @ #tib @ < while eval1 repeat ;
-: eval ( a n -- ) 'tib @ >r #tib @ >r >in @ >r
-                  #tib ! 'tib ! 0 >in ! eval-buffer
-                  r> >in ! r> #tib ! r> 'tib ! ;
-: query   begin ['] eval-buffer catch
+: evaluate-buffer   begin >in @ #tib @ < while evaluate1 repeat ;
+: evaluate ( a n -- ) 'tib @ >r #tib @ >r >in @ >r
+                      #tib ! 'tib ! 0 >in ! evaluate-buffer
+                      r> >in ! r> #tib ! r> 'tib ! ;
+: query   begin ['] evaluate-buffer catch
           if ." ERROR" cr then prompt refill drop again ;
 : ok   ." uEForth" cr prompt refill drop query ;
diff --git a/ueforth/common/core.h b/ueforth/common/core.h
index 5f7a597..8f2f7e3 100644
--- a/ueforth/common/core.h
+++ b/ueforth/common/core.h
@@ -1,12 +1,18 @@
+#define PRINT_ERRORS 0
+
 #define NEXT w = *ip++; goto **(void **) w
 #define CELL_LEN(n) (((n) + sizeof(cell_t) - 1) / sizeof(cell_t))
 #define FIND(name) find(name, sizeof(name) - 1)
 #define LOWER(ch) ((ch) & 95)
 
+#if PRINT_ERRORS
+#include <unistd.h>
+#endif
+
 static struct {
   const char *tib;
   cell_t ntib, tin, state, base;
-  cell_t *heap, *last, tthrow;
+  cell_t *heap, *last, notfound;
   cell_t DOLIT_XT, DOEXIT_XT;
 } g_sys;
 
@@ -68,7 +74,7 @@ static cell_t parse(cell_t sep, cell_t *ret) {
   return len;
 }
 
-static cell_t *eval1(cell_t *sp, cell_t *call) {
+static cell_t *evaluate1(cell_t *sp, cell_t *call) {
   *call = 0;
   cell_t name;
   cell_t len = parse(' ', &name);
@@ -90,9 +96,13 @@ static cell_t *eval1(cell_t *sp, cell_t *call) {
         *++sp = n;
       }
     } else {
-      //write(2, (void *) name, len);
+#if PRINT_ERRORS
+      write(2, (void *) name, len);
+#endif
+      *++sp = name;
+      *++sp = len;
       *++sp = -1;
-      *call = g_sys.tthrow;
+      *call = g_sys.notfound;
     }
   }
   return sp;
@@ -113,9 +123,9 @@ static void ueforth(void *heap, const char *src, cell_t src_len) {
   g_sys.last[-1] = 1;  // Make ; IMMEDIATE
   g_sys.DOLIT_XT = FIND("DOLIT");
   g_sys.DOEXIT_XT = FIND("EXIT");
-  g_sys.tthrow = FIND("DROP");
+  g_sys.notfound = FIND("DROP");
   ip = g_sys.heap;
-  *g_sys.heap++ = FIND("EVAL1");
+  *g_sys.heap++ = FIND("EVALUATE1");
   *g_sys.heap++ = FIND("BRANCH");
   *g_sys.heap++ = (cell_t) ip;
   g_sys.base = 10;
diff --git a/ueforth/common/opcodes.h b/ueforth/common/opcodes.h
index f0e03fa..a21d4cc 100644
--- a/ueforth/common/opcodes.h
+++ b/ueforth/common/opcodes.h
@@ -71,9 +71,9 @@ typedef uint64_t udcell_t;
   X(":", OP_COLON, t = parse(32, &tmp); \
                    create((const char *) tmp, t, 0, && OP_DOCOL); \
                    g_sys.state = -1) \
-  X("EVAL1", OP_EVAL1, DUP; sp = eval1(sp, &tmp); \
-            DROP; if (tmp) (w = tmp); \
-            if (tmp) goto **(void **) w) \
+  X("EVALUATE1", OP_EVALUATE1, DUP; sp = evaluate1(sp, &tmp); \
+                               DROP; if (tmp) (w = tmp); \
+                               if (tmp) goto **(void **) w) \
   X("EXIT", OP_EXIT, ip = (void *) *rp--) \
   X(";", OP_SEMICOLON, *g_sys.heap++ = g_sys.DOEXIT_XT; g_sys.state = 0) \