Add size field.

ueforth/common/boot.fs

@@ -66,13 +66,15 @@
 
 ( System Variables )
 : sys: ( a -- a' "name" ) dup constant cell+ ;
-'sys   sys: 'heap         sys: current       sys: 'context       sys: 'notfound
+'sys   sys: 'heap         sys: current       sys: 'context
+       sys: 'latestxt     sys: 'notfound
        sys: 'heap-start   sys: 'heap-size    sys: 'stack-cells
        sys: 'boot         sys: 'boot-size
        sys: 'tib          sys: #tib          sys: >in
        sys: state         sys: base
        sys: 'argc         sys: 'argv         sys: 'runner
 : context ( -- a ) 'context @ cell+ ;
+: latestxt ( -- xt ) 'latestxt @ ;
 : remaining ( -- n ) 'heap-start @ 'heap-size @ + 'heap @ - ;
 : used ( -- n ) 'heap @ sp@ 'stack-cells @ cells + - 28 + ;
 
@@ -109,9 +111,11 @@
 
 ( Dictionary Format )
 : >flags& ( xt -- a ) cell - ; : >flags ( xt -- flags ) >flags& c@ ;
-: >length ( xt -- n ) >flags& @ 8 rshift ;
+: >name-length ( xt -- n ) >flags& 1+ c@ ;
+: >params ( xt -- n ) >flags& 2 + sw@ $ffff and ;
+: >size ( xt -- n ) dup >params cells swap >name-length aligned + 3 cells + ;
 : >link& ( xt -- a ) 2 cells - ;   : >link ( xt -- a ) >link& @ ;
-: >name ( xt -- a n ) dup >length swap >link& over aligned - swap ;
+: >name ( xt -- a n ) dup >name-length swap >link& over aligned - swap ;
 : >body ( xt -- a ) dup @ [ ' >flags @ ] literal = 2 + cells + ;
 
 ( Postpone - done here so we have ['] and IF )

ueforth/common/core.h

@@ -30,7 +30,8 @@
 #endif
 
 static struct {
-  cell_t *heap, **current, ***context, notfound;
+  cell_t *heap, **current, ***context;
+  cell_t *latestxt, notfound;
   cell_t *heap_start;
   cell_t heap_size, stack_cells;
   const char *boot;
@@ -112,7 +113,7 @@ static cell_t find(const char *name, cell_t len) {
     cell_t *pos = **voc;
     cell_t clen = CELL_LEN(len);
     while (pos) {
-      if (!(pos[-1] & SMUDGE) && len == (pos[-1] >> 8) &&
+      if (!(pos[-1] & SMUDGE) && len == ((pos[-1] >> 8) & 0xff) &&
           same(name, (const char *) &pos[-2 - clen], len)) {
         return (cell_t) pos;
       }
@@ -122,14 +123,18 @@ static cell_t find(const char *name, cell_t len) {
   return 0;
 }
 
-static void create(const char *name, cell_t length, cell_t flags, void *op) {
+static void create(const char *name, cell_t nlength, cell_t flags, void *op) {
+  if (g_sys.latestxt) {
+    g_sys.latestxt[-1] |= ((g_sys.heap - &g_sys.latestxt[1]) << 16);
+  }
   g_sys.heap = (cell_t *) CELL_ALIGNED(g_sys.heap);
   char *pos = (char *) g_sys.heap;
-  for (cell_t n = length; n; --n) { *pos++ = *name++; }  // name
-  g_sys.heap += CELL_LEN(length);
+  for (cell_t n = nlength; n; --n) { *pos++ = *name++; }  // name
+  g_sys.heap += CELL_LEN(nlength);
   *g_sys.heap++ = (cell_t) *g_sys.current;  // link
-  *g_sys.heap++ = (length << 8) | flags;  // flags & length
+  *g_sys.heap++ = (nlength << 8) | flags;  // flags & length
   *g_sys.current = g_sys.heap;
+  g_sys.latestxt = g_sys.heap;
   *g_sys.heap++ = (cell_t) op;  // code
 }
 
@@ -218,6 +223,7 @@ static void forth_init(int argc, char *argv[], void *heap,
   // Vocabulary stack
   g_sys.current = (cell_t **) forth_wordlist;
   g_sys.context = (cell_t ***) g_sys.heap;
+  g_sys.latestxt = 0;
   *g_sys.heap++ = (cell_t) forth_wordlist;
   for (int i = 0; i < VOCABULARY_DEPTH; ++i) { *g_sys.heap++ = 0; }
 

ueforth/common/forth_namespace_tests.fs

@@ -125,7 +125,9 @@ e: check-boot
   out: >name 
   out: >link 
   out: >link& 
-  out: >length 
+  out: >size 
+  out: >params 
+  out: >name-length 
   out: >flags 
   out: >flags& 
   out: abs 
@@ -151,6 +153,7 @@ e: check-boot
   out: [ 
   out: used 
   out: remaining 
+  out: latestxt 
   out: context 
   out: base 
   out: state 

ueforth/common/utils.fs

@@ -79,7 +79,7 @@ internals definitions
 ( Words to measure size of things )
 : size-vocabulary ( voc )
   @ begin dup nonvoc? while
-    dup see. dup dup >link - . >link
+    dup see. dup >size . cr >link
   repeat drop cr ;
 : size-all
   last-vocabulary @ begin dup while

ueforth/common/vocabulary.fs

@@ -53,7 +53,7 @@ transfer{
   immediate? input-buffer ?echo ?arrow. arrow
   evaluate1 evaluate-buffer
   'sys 'heap aliteral 'heap-start 'heap-size
-  'stack-cells 'boot 'boot-size
+  'stack-cells 'boot 'boot-size 'latestxt
   'argc 'argv 'runner
   leaving( )leaving leaving leaving,
   (do) (?do) (+loop)