Adding vlist, fix smudge.

ueforth/common/boot.fs

@@ -79,7 +79,7 @@
 
 ( Dictionary Format )
 : >name ( xt -- a n ) 3 cells - dup @ swap over aligned - swap ;
-: >link ( xt -- a ) 2 cells - @ ;
+: >link& ( xt -- a ) 2 cells - ;   : >link ( xt -- a ) >link& @ ;
 : >flags ( xt -- flags ) cell - ;
 : >body ( xt -- a ) dup @ [ ' >flags @ ] literal = 2 + cells + ;
 

ueforth/common/core.h

@@ -3,6 +3,8 @@
 #define CELL_LEN(n) (((n) + sizeof(cell_t) - 1) / sizeof(cell_t))
 #define FIND(name) find(name, sizeof(name) - 1)
 #define LOWER(ch) ((ch) & 0x5F)
+#define IMMEDIATE 1
+#define SMUDGE 2
 
 #if PRINT_ERRORS
 #include <unistd.h>
@@ -48,7 +50,7 @@ static cell_t find(const char *name, cell_t len) {
   cell_t *pos = *g_sys.context;
   cell_t clen = CELL_LEN(len);
   while (pos) {
-    if (len == pos[-3] &&
+    if (!(pos[-1] & SMUDGE) && len == pos[-3] &&
         same(name, (const char *) &pos[-3 - clen], len) == 0) {
       return (cell_t) pos;
     }
@@ -90,7 +92,7 @@ static cell_t *evaluate1(cell_t *sp) {
   if (len == 0) { *++sp = 0; return sp; }  // ignore empty
   cell_t xt = find((const char *) name, len);
   if (xt) {
-    if (g_sys.state && !(((cell_t *) xt)[-1] & 1)) {  // bit 0 of flags is immediate
+    if (g_sys.state && !(((cell_t *) xt)[-1] & IMMEDIATE)) {
       *g_sys.heap++ = xt;
     } else {
       call = xt;
@@ -135,7 +137,7 @@ static void ueforth_init(int argc, char *argv[], void *heap,
   *g_sys.heap++ = 0;  *g_sys.heap++ = 0;  *g_sys.heap++ = 0;
 
   ueforth_run(0);
-  (*g_sys.current)[-1] = 1;  // Make last word ; IMMEDIATE
+  (*g_sys.current)[-1] = IMMEDIATE;  // Make last word ; IMMEDIATE
   g_sys.DOLIT_XT = FIND("DOLIT");
   g_sys.DOEXIT_XT = FIND("EXIT");
   g_sys.YIELD_XT = FIND("YIELD");

ueforth/common/opcodes.h

@@ -9,7 +9,8 @@ typedef uintptr_t ucell_t;
 #define DUP *++sp = tos
 #define DROP tos = *sp--
 #define COMMA(n) *g_sys.heap++ = (n)
-#define IMMEDIATE() (*g_sys.current)[-1] |= 1
+#define DOIMMEDIATE() (*g_sys.current)[-1] |= IMMEDIATE
+#define UNSMUDGE() (*g_sys.current)[-1] &= ~SMUDGE
 #define DOES(ip) **g_sys.current = (cell_t) ADDR_DODOES; (*g_sys.current)[1] = (cell_t) ip
 #define PARK DUP; *++rp = (cell_t) sp; *++rp = (cell_t) ip
 
@@ -69,14 +70,14 @@ typedef int64_t dcell_t;
                       create((const char *) *sp, tos, 0, ADDR_DOCREATE); \
                       COMMA(0); --sp; DROP) \
   X("DOES>", DOES, DOES(ip); ip = (cell_t *) *rp; --rp) \
-  X("IMMEDIATE", IMMEDIATE, IMMEDIATE()) \
+  X("IMMEDIATE", IMMEDIATE, DOIMMEDIATE()) \
   X("'SYS", SYS, DUP; tos = (cell_t) &g_sys) \
   X("YIELD", YIELD, PARK; return rp) \
   X(":", COLON, DUP; DUP; tos = parse(32, sp); \
-                create((const char *) *sp, tos, 0, ADDR_DOCOLON); \
+                create((const char *) *sp, tos, SMUDGE, ADDR_DOCOLON); \
                 g_sys.state = -1; --sp; DROP) \
   X("EVALUATE1", EVALUATE1, DUP; sp = evaluate1(sp); w = *sp--; DROP; \
                             if (w) JMPW) \
   X("EXIT", EXIT, ip = (cell_t *) *rp--) \
-  X(";", SEMICOLON, COMMA(g_sys.DOEXIT_XT); g_sys.state = 0) \
+  X(";", SEMICOLON, UNSMUDGE(); COMMA(g_sys.DOEXIT_XT); g_sys.state = 0) \
 

ueforth/common/vocabulary.fs

@@ -1,6 +1,9 @@
 ( Implement Vocabularies )
-: forth    [ current @ ] literal context ! ;
+: forth   [ current @ ] literal context ! ;
 : vocabulary ( "name" ) create 0 , current @ 2 cells + , does> cell+ context ! ;
 : definitions   context @ current ! ;
-: vlist   0 context @ @ begin onlines dup see. >link dup 0= if 2drop cr exit then
+: >name-length ( xt -- n ) dup 0= if exit then >name nip ;
-                        dup >name nip 0= until 2drop cr ;
+: vlist   0 context @ @ begin dup >name-length while onlines dup see. >link repeat 2drop cr ;
+: transfer ( "name" ) ' context @ begin 2dup @ <> while @ >link& repeat nip
+                      dup @ swap dup @ >link swap ! current @ @ over >link& !
+                      current @ ! ;

ueforth/common/vocabulary_tests.fs

@@ -22,3 +22,10 @@ e: test-vlist
   forth definitions
   out: sheep cow pig 
 ;e
+
+e: test-vlist-empty
+  vocabulary foo
+  foo vlist
+  forth definitions
+  out:
+;e

ueforth/web/web.template.js

@@ -143,7 +143,8 @@ function VM(stdlib, foreign, heap) {
   var Call = foreign.Call;
   var COMMA = foreign.COMMA;
   var DOES = foreign.DOES;
-  var IMMEDIATE = foreign.IMMEDIATE;
+  var DOIMMEDIATE = foreign.DOIMMEDIATE;
+  var UNSMUDGE = foreign.UNSMUDGE;
   var create = foreign.create;
   var find = foreign.find;
   var parse = foreign.parse;
@@ -216,7 +217,8 @@ var ffi = {
   COMMA: function(n) { i32[i32[g_heap>>2]] = n; i32[g_heap>>2] += 4; console.log('comma'); },
   SSMOD: function() { console.log('ssmod'); },
   DOES: function() { console.log('does'); },
-  IMMEDIATE: function() { console.log('immediate'); },
+  DOIMMEDIATE: function() { console.log('immediate'); },
+  UNSMUDGE: function() { console.log('unsmudge'); },
   parse: function() { console.log('parse'); },
   find: function() { console.log('find'); },
   convert: function() { console.log('convert'); },