Builtins now internals, but vlist skips them.

ueforth/common/core.h

@@ -22,6 +22,7 @@
 #define IMMEDIATE 1
 #define SMUDGE 2
 #define BUILTIN_FORK 4
+#define BUILTIN_MARK 8
 
 // Maximum ALSO layers.
 #define VOCABULARY_DEPTH 16
@@ -242,7 +243,8 @@ static void forth_init(int argc, char *argv[], void *heap,
   for (int i = 0; i < VOCABULARY_DEPTH; ++i) { *g_sys.heap++ = 0; }
 
   forth_run(0);
-  g_sys.latestxt = 0;  // So ; doesn't get wrong size.
+  create("end", 3, BUILTIN_FORK, 0);
+  g_sys.latestxt = 0;  // So last builtin doesn't get wrong size.
   g_sys.DOLIT_XT = FIND("DOLIT");
   g_sys.DOFLIT_XT = FIND("DOFLIT");
   g_sys.DOEXIT_XT = FIND("EXIT");

ueforth/common/forth_namespace_tests.fs

@@ -397,9 +397,9 @@ e: check-phase1
   check-vocabulary
   check-[]conds
   check-boot
-  check-core-opcodes
+\  check-core-opcodes
-  check-extra-opcodes
+\  check-extra-opcodes
-  check-float-opcodes
+\  check-float-opcodes
 ;e
 
 e: check-desktop
@@ -446,8 +446,9 @@ e: test-windows-forth-namespace
   out: default-type 
   out: windows 
   check-phase1
-  out: LOADLIBRARYA 
+  \ out: LOADLIBRARYA 
-  out: GETPROCADDRESS 
+  \ out: GETPROCADDRESS 
+  out: end 
 ;e
 
 [ELSE] DEFINED? posix [IF]
@@ -487,7 +488,8 @@ e: test-posix-forth-namespace
   out: default-type 
   out: posix 
   check-phase1
-  out: DLSYM 
+\  out: DLSYM 
+  out: end 
 ;e 
 
 [ELSE]
@@ -581,7 +583,8 @@ e: test-esp32-forth-namespace
   check-phase2
   check-allocation
   check-phase1
-  check-esp32-basics2
+\  check-esp32-basics2
+  out: end 
 ;e 
 
 [THEN] [THEN] 

ueforth/common/interp.h

@@ -21,7 +21,8 @@
 static cell_t *forth_run(cell_t *init_rp) {
   static const BUILTIN_WORD builtins[] = {
 #define XV(flags, name, op, code) \
-    name, 0, sizeof(name) - 1, (flags & 0xff), && OP_ ## op,
+    name, ((flags >> 8) & 0xff) | BUILTIN_MARK, \
+    sizeof(name) - 1, (flags & 0xff), && OP_ ## op,
     PLATFORM_OPCODE_LIST
     EXTRA_OPCODE_LIST
     OPCODE_LIST
@@ -31,11 +32,6 @@ static cell_t *forth_run(cell_t *init_rp) {
 
   if (!init_rp) {
     g_sys.builtins = builtins;
-#define XV(flags, name, op, code) create(name, sizeof(name) - 1, name[0] == ';', && OP_ ## op);
-    PLATFORM_OPCODE_LIST
-    EXTRA_OPCODE_LIST
-    OPCODE_LIST
-#undef XV
     return 0;
   }
   register cell_t *ip, *rp, *sp, tos, w;

ueforth/common/opcodes.h

@@ -23,6 +23,7 @@ typedef uintptr_t ucell_t;
 #define YV(flags, op, code) XV(flags, #op, ID_ ## op, code)
 #define X(name, op, code) XV(FORTH, name, op, code)
 #define Y(op, code) XV(FORTH, #op, ID_ ## op, code)
+#define FL(vocab, flags) ((vocab) | ((flags) << 8))
 
 #define NIP (--sp)
 #define NIPn(n) (sp -= (n))
@@ -41,7 +42,8 @@ typedef uintptr_t ucell_t;
 #define TOPARAMS(xt) ((uint16_t *) (TOFLAGS(xt) + 2))
 #define TOSIZE(xt) (CELL_ALIGNED(*TONAMELEN(xt)) + sizeof(cell_t) * (3 + *TOPARAMS(xt)))
 #define TOLINK(xt) (((cell_t *) (xt)) - 2)
-#define TONAME(xt) (((char *) TOLINK(xt)) - CELL_ALIGNED(*TONAMELEN(xt)))
+#define TONAME(xt) ((*TOFLAGS(xt) & BUILTIN_MARK) ? (*(char **) TOLINK(xt)) \
+    : (((char *) TOLINK(xt)) - CELL_ALIGNED(*TONAMELEN(xt))))
 #define TOBODY(xt) (((cell_t *) xt) + ((void *) *((cell_t *) xt) == ADDR_DOCOLON ? 1 : 2))
 
 #define DOIMMEDIATE() *TOFLAGS(*g_sys.current) |= IMMEDIATE
@@ -124,4 +126,4 @@ typedef struct {
                sp = evaluate1(sp, &tfp); \
                fp = tfp; w = *sp--; DROP; if (w) JMPW) \
   Y(EXIT, ip = (cell_t *) *rp--) \
-  X(";", SEMICOLON, COMMA(g_sys.DOEXIT_XT); UNSMUDGE(); g_sys.state = 0)
+  XV(FL(FORTH, IMMEDIATE), ";", SEMICOLON, COMMA(g_sys.DOEXIT_XT); UNSMUDGE(); g_sys.state = 0)

ueforth/common/utils.fs

@@ -26,7 +26,8 @@
 
 internals definitions
 2 constant SMUDGE
-8 constant NONAMED
+4 constant BUILTIN_FORK
+16 constant NONAMED
 : mem= ( a a n -- f)
    for aft 2dup c@ swap c@ <> if 2drop rdrop 0 exit then 1+ swap 1+ then next 2drop -1 ;
 forth definitions also internals
@@ -64,7 +65,7 @@ internals definitions
   ." Unsupported: " see. cr ;
 
 : nonvoc? ( xt -- f )
-  dup 0= if exit then dup >name nip swap >flags NONAMED and or ;
+  dup 0= if exit then dup >name nip swap >flags NONAMED BUILTIN_FORK or and or ;
 : see-vocabulary ( voc )
   @ begin dup nonvoc? while dup see-xt >link repeat drop cr ;
 : >vocnext ( xt -- xt ) >body 2 cells + @ ;

ueforth/common/vocabulary.fs

@@ -28,7 +28,9 @@ forth definitions
 ( Make it easy to transfer words between vocabularies )
 : xt-find& ( xt -- xt& ) context @ begin 2dup @ <> while @ >link& repeat nip ;
 : xt-hide ( xt -- ) xt-find& dup @ >link swap ! ;
-: xt-transfer ( xt --  ) dup xt-hide   current @ @ over >link& !   current @ ! ;
+8 constant BUILTIN_MARK
+: xt-transfer ( xt --  ) dup >flags BUILTIN_MARK and if drop exit then
+  dup xt-hide   current @ @ over >link& !   current @ ! ;
 : transfer ( "name" ) ' xt-transfer ;
 : }transfer ;
 : transfer{ begin ' dup ['] }transfer = if drop exit then xt-transfer again ;
@@ -60,7 +62,7 @@ transfer{
   parse-quote digit $@ raw.s
   tib-setup input-limit
   [SKIP] [SKIP]' raw-ok
-  $place zplace sys:
+  $place zplace sys: BUILTIN_MARK
 }transfer
 forth definitions
 

ueforth/windows/interp.h

@@ -32,7 +32,8 @@ enum {
 static cell_t *forth_run(cell_t *init_rp) {
   static const BUILTIN_WORD builtins[] = {
 #define XV(flags, name, op, code) \
-    name, 0, sizeof(name) - 1, (flags & 0xff), (void *) OP_ ## op,
+    name, ((flags >> 8) & 0xff) | BUILTIN_MARK, sizeof(name) - 1, \
+    (flags & 0xff), (void *) OP_ ## op,
     PLATFORM_OPCODE_LIST
     EXTRA_OPCODE_LIST
     OPCODE_LIST
@@ -41,12 +42,6 @@ static cell_t *forth_run(cell_t *init_rp) {
 
   if (!init_rp) {
     g_sys.builtins = builtins;
-#define XV(flags, name, op, code) \
-    create(name, sizeof(name) - 1, name[0] == ';', (void *) OP_ ## op);
-    PLATFORM_OPCODE_LIST
-    EXTRA_OPCODE_LIST
-    OPCODE_LIST
-#undef XV
     return 0;
   }
   register cell_t *ip, *rp, *sp, tos, w;