New builtins work now.

ueforth/Makefile

@@ -179,7 +179,7 @@ $(GEN):
 COMMON_PHASE1 = common/boot.fs common/conditionals.fs common/vocabulary.fs \
                      common/floats.fs
 
-COMMON_DESKTOP = common/hide_calls.fs common/ansi.fs common/desktop.fs
+COMMON_DESKTOP = common/ansi.fs common/desktop.fs
 
 COMMON_PHASE2 = common/tasks.fs common/utils.fs common/locals.fs \
                 common/filetools.fs common/including.fs \

ueforth/common/calls.h

@@ -25,15 +25,14 @@ typedef cell_t (CALLTYPE *call_t)();
 #define ct0 ((call_t) n0)
 
 #define CALLING_OPCODE_LIST \
-  Y(CALL0, n0 = ct0()) \
+  YV(internals, CALL0, n0 = ct0()) \
-  Y(CALL1, n0 = ct0(n1); --sp) \
+  YV(internals, CALL1, n0 = ct0(n1); --sp) \
-  Y(CALL2, n0 = ct0(n2, n1); sp -= 2) \
+  YV(internals, CALL2, n0 = ct0(n2, n1); sp -= 2) \
-  Y(CALL3, n0 = ct0(n3, n2, n1); sp -= 3) \
+  YV(internals, CALL3, n0 = ct0(n3, n2, n1); sp -= 3) \
-  Y(CALL4, n0 = ct0(n4, n3, n2, n1); sp -= 4) \
+  YV(internals, CALL4, n0 = ct0(n4, n3, n2, n1); sp -= 4) \
-  Y(CALL5, n0 = ct0(n5, n4, n3, n2, n1); sp -= 5) \
+  YV(internals, CALL5, n0 = ct0(n5, n4, n3, n2, n1); sp -= 5) \
-  Y(CALL6, n0 = ct0(n6, n5, n4, n3, n2, n1); sp -= 6) \
+  YV(internals, CALL6, n0 = ct0(n6, n5, n4, n3, n2, n1); sp -= 6) \
-  Y(CALL7, n0 = ct0(n7, n6, n5, n4, n3, n2, n1); sp -= 7) \
+  YV(internals, CALL7, n0 = ct0(n7, n6, n5, n4, n3, n2, n1); sp -= 7) \
-  Y(CALL8, n0 = ct0(n8, n7, n6, n5, n4, n3, n2, n1); sp -= 8) \
+  YV(internals, CALL8, n0 = ct0(n8, n7, n6, n5, n4, n3, n2, n1); sp -= 8) \
-  Y(CALL9, n0 = ct0(n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 9) \
+  YV(internals, CALL9, n0 = ct0(n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 9) \
-  Y(CALL10, n0 = ct0(n10, n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 10) \
+  YV(internals, CALL10, n0 = ct0(n10, n9, n8, n7, n6, n5, n4, n3, n2, n1); sp -= 10)
-

ueforth/common/floats.fs

@@ -27,7 +27,6 @@ internals definitions
 : #f+s ( r -- ) fdup precision 0 ?do 10e f* loop
                 precision 0 ?do fdup f>s 10 mod [char] 0 + hold 0.1e f* loop
                 [char] . hold fdrop f>s #s ;
-transfer doflit
 forth definitions internals
 
 : #fs ( r -- ) fdup f0< if fnegate #f+s [char] - hold else #f+s then ;

ueforth/common/floats.h

@@ -13,7 +13,7 @@
 // limitations under the License.
 
 #define FLOATING_POINT_LIST \
-  Y(DOFLIT, *++fp = *(float *) ip++) \
+  YV(internals, DOFLIT, *++fp = *(float *) ip++) \
   X("FP@", FPAT, DUP; tos = (cell_t) fp) \
   X("FP!", FPSTORE, fp = (float *) tos; DROP) \
   X("SF@", FAT, *++fp = *(float *) tos; DROP) \
@@ -39,7 +39,7 @@
   X("1/F", FINVERSE, *fp = 1.0 / *fp) \
   X("S>F", STOF, *++fp = (float) tos; DROP) \
   X("F>S", FTOS, DUP; tos = (cell_t) *fp--) \
-  X("F>NUMBER?", FCONVERT, tos = fconvert((const char *) *sp, tos, fp); --sp) \
+  XV(internals, "F>NUMBER?", FCONVERT, tos = fconvert((const char *) *sp, tos, fp); --sp) \
   Y(SFLOAT, DUP; tos = sizeof(float)) \
   Y(SFLOATS, tos *= sizeof(float)) \
   X("SFLOAT+", SFLOATPLUS, DUP; tos += sizeof(float)) \

ueforth/common/forth_namespace_tests.fs

@@ -13,7 +13,18 @@
 \ limitations under the License.
 
 also internals
-: list-from ( xt ) begin dup nonvoc? while dup see. cr >link repeat drop ;
+: list-builtins ( voc )
+  >r 'builtins begin dup >link while
+    dup >params r@ = if dup see. cr then
+    3 cells +
+  repeat drop rdrop ;
+: list-from ( xt ) begin dup nonvoc? while
+    dup >flags BUILTIN_FORK and if
+      dup cell+ @ list-builtins
+    then
+    dup see. cr
+    >link
+  repeat drop ;
 
 e: check-locals
   out: +to 
@@ -137,143 +148,141 @@ e: check-boot
 ;e
 
 e: check-extra-opcodes
-  out: >body 
-  out: >name 
-  out: >link 
-  out: >link& 
-  out: >size 
-  out: >params 
-  out: >flags 
-
-  out: c, 
-  out: , 
-  out: align 
-  out: aligned 
-  out: allot 
-  out: here 
-
-  out: abs 
-  out: max 
-  out: min 
-
-  out: blank 
-  out: erase 
-  out: fill 
-  out: cmove> 
-  out: cmove 
-
-  out: 2! 
-  out: 2@ 
-  out: 2dup 
-  out: 2drop 
-  out: cell/ 
-  out: cells 
-  out: cell+ 
-  out: +! 
-  out: 4/ 
-  out: 4* 
-  out: 2/ 
-  out: 2* 
-  out: 1- 
-  out: 1+ 
-  out: nl 
-  out: bl 
-  out: 0<> 
-  out: <> 
-  out: = 
-  out: >= 
-  out: <= 
-  out: > 
-  out: < 
-  out: -rot 
-  out: rot 
-  out: - 
-  out: negate 
-  out: invert 
-  out: mod 
-  out: / 
-  out: /mod 
-  out: * 
-  out: */ 
-  out: rdrop 
   out: nip 
+  out: rdrop 
+  out: */ 
+  out: * 
+  out: /mod 
+  out: / 
+  out: mod 
+  out: invert 
+  out: negate 
+  out: - 
+  out: rot 
+  out: -rot 
+  out: < 
+  out: > 
+  out: <= 
+  out: >= 
+  out: = 
+  out: <> 
+  out: 0<> 
+  out: bl 
+  out: nl 
+  out: 1+ 
+  out: 1- 
+  out: 2* 
+  out: 2/ 
+  out: 4* 
+  out: 4/ 
+  out: +! 
+  out: cell+ 
+  out: cells 
+  out: cell/ 
+  out: 2drop 
+  out: 2dup 
+  out: 2@ 
+  out: 2! 
+
+  out: cmove 
+  out: cmove> 
+  out: fill 
+  out: erase 
+  out: blank 
+
+  out: min 
+  out: max 
+  out: abs 
+
+  out: here 
+  out: allot 
+  out: aligned 
+  out: align 
+  out: , 
+  out: c, 
+
+  out: >flags 
+  out: >params 
+  out: >size 
+  out: >link& 
+  out: >link 
+  out: >name 
+  out: >body 
 ;e
 
 e: check-core-opcodes
-  out: ; 
-  out: EXIT 
-  out: : 
-  out: IMMEDIATE 
-  out: DOES> 
-  out: CREATE 
-  out: S>NUMBER? 
-  out: PARSE 
-  out: FIND 
-  out: CELL 
-  out: EXECUTE 
-  out: R@ 
-  out: R> 
-  out: >R 
-  out: RP! 
-  out: RP@ 
-  out: SP! 
-  out: SP@ 
-  out: C! 
-  out: W! 
-  out: L! 
-  out: ! 
-  out: C@ 
-  out: SW@ 
-  out: SL@ 
-  out: @ 
-  out: DROP 
-  out: OVER 
-  out: SWAP 
-  out: DUP 
-  out: XOR 
-  out: OR 
-  out: AND 
-  out: RSHIFT 
-  out: LSHIFT 
-  out: */MOD 
-  out: U/MOD 
-  out: + 
-  out: 0< 
   out: 0= 
+  out: 0< 
+  out: + 
+  out: U/MOD 
+  out: */MOD 
+  out: LSHIFT 
+  out: RSHIFT 
+  out: AND 
+  out: OR 
+  out: XOR 
+  out: DUP 
+  out: SWAP 
+  out: OVER 
+  out: DROP 
+  out: @ 
+  out: SL@ 
+  out: SW@ 
+  out: C@ 
+  out: ! 
+  out: L! 
+  out: W! 
+  out: C! 
+  out: SP@ 
+  out: SP! 
+  out: RP@ 
+  out: RP! 
+  out: >R 
+  out: R> 
+  out: R@ 
+  out: EXECUTE 
+  out: CELL 
+  out: FIND 
+  out: PARSE 
+  out: CREATE 
+  out: DOES> 
+  out: IMMEDIATE 
+  out: : 
+  out: EXIT 
+  out: ; 
 ;e
 
 e: check-float-opcodes
-  out: FSQRT 
-  out: PI 
-  out: SFLOAT+ 
-  out: SFLOATS 
-  out: SFLOAT 
-  out: F>NUMBER? 
-  out: F>S 
-  out: S>F 
-  out: 1/F 
-  out: F/ 
-  out: F* 
-  out: F- 
-  out: F+ 
-  out: F>= 
-  out: F<= 
-  out: F<> 
-  out: F> 
-  out: F< 
-  out: F= 
-  out: F0= 
-  out: F0< 
-  out: FNEGATE 
-  out: FSWAP 
-  out: FOVER 
-  out: FDROP 
-  out: FNIP 
-  out: FDUP 
-  out: SF! 
-  out: SF@ 
-  out: FP! 
   out: FP@ 
+  out: FP! 
+  out: SF@ 
+  out: SF! 
+  out: FDUP 
+  out: FNIP 
+  out: FDROP 
+  out: FOVER 
+  out: FSWAP 
+  out: FNEGATE 
+  out: F0< 
+  out: F0= 
+  out: F= 
+  out: F< 
+  out: F> 
+  out: F<> 
+  out: F<= 
+  out: F>= 
+  out: F+ 
+  out: F- 
+  out: F* 
+  out: F/ 
+  out: 1/F 
+  out: S>F 
+  out: F>S 
+  out: SFLOAT 
+  out: SFLOATS 
+  out: SFLOAT+ 
+  out: PI 
+  out: FSQRT 
 ;e
 
 e: check-files
@@ -296,6 +305,26 @@ e: check-files
   out: R/O 
 ;e
 
+e: check-files-reverse
+  out: R/O 
+  out: W/O 
+  out: R/W 
+  out: BIN 
+  out: CLOSE-FILE 
+  out: FLUSH-FILE 
+  out: OPEN-FILE 
+  out: CREATE-FILE 
+  out: DELETE-FILE 
+  out: RENAME-FILE 
+  out: WRITE-FILE 
+  out: READ-FILE 
+  out: FILE-POSITION 
+  out: REPOSITION-FILE 
+  out: RESIZE-FILE 
+  out: FILE-SIZE 
+  out: NON-BLOCK 
+;e
+
 e: check-blocks
   out: editor 
   out: list 
@@ -397,9 +426,12 @@ e: check-phase1
   check-vocabulary
   check-[]conds
   check-boot
-\  check-core-opcodes
+;e
-\  check-extra-opcodes
+
-\  check-float-opcodes
+e: check-opcodes
+  check-float-opcodes
+  check-extra-opcodes
+  check-core-opcodes
 ;e
 
 e: check-desktop
@@ -446,8 +478,9 @@ e: test-windows-forth-namespace
   out: default-type 
   out: windows 
   check-phase1
-  \ out: LOADLIBRARYA 
+  out: GETPROCADDRESS 
-  \ out: GETPROCADDRESS 
+  out: LOADLIBRARYA 
+  check-opcodes
   out: forth-builtins 
 ;e
 
@@ -488,7 +521,8 @@ e: test-posix-forth-namespace
   out: default-type 
   out: posix 
   check-phase1
-\  out: DLSYM 
+  out: DLSYM 
+  check-opcodes
   out: forth-builtins 
 ;e 
 
@@ -533,17 +567,17 @@ e: check-esp32-basics
   out: pin 
 ;e
 
-e: check-esp32-basics2
+e: check-esp32-builtins
-  out: MDNS.begin 
-  out: dacWrite 
-  check-files
-  out: TERMINATE 
-  out: MS-TICKS 
-  out: pulseIn 
-  out: analogRead 
-  out: digitalRead 
-  out: digitalWrite 
   out: pinMode 
+  out: digitalWrite 
+  out: digitalRead 
+  out: analogRead 
+  out: pulseIn 
+  out: MS-TICKS 
+  out: TERMINATE 
+  check-files-reverse
+  out: dacWrite 
+  out: MDNS.begin 
 ;e
 
 e: test-esp32-forth-namespace
@@ -583,7 +617,8 @@ e: test-esp32-forth-namespace
   check-phase2
   check-allocation
   check-phase1
-\  check-esp32-basics2
+  check-esp32-builtins
+  check-opcodes
   out: forth-builtins 
 ;e 
 

ueforth/common/hide_calls.fs

@@ -1,19 +0,0 @@
-\ Copyright 2021 Bradley D. Nelson
-\
-\ Licensed under the Apache License, Version 2.0 (the "License");
-\ you may not use this file except in compliance with the License.
-\ You may obtain a copy of the License at
-\
-\     http://www.apache.org/licenses/LICENSE-2.0
-\
-\ Unless required by applicable law or agreed to in writing, software
-\ distributed under the License is distributed on an "AS IS" BASIS,
-\ WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
-\ See the License for the specific language governing permissions and
-\ limitations under the License.
-
-internals definitions
-transfer{
-  call0 call1 call2 call3 call4 call5 call6 call7 call8 call9 call10
-}transfer
-forth definitions

ueforth/common/opcodes.h

@@ -63,8 +63,13 @@ typedef int64_t dcell_t;
 
 typedef struct {
   const char *name;
-  uint8_t flags, name_length;
+  union {
-  uint16_t vocabulary;
+    struct {
+      uint8_t flags, name_length;
+      uint16_t vocabulary;
+    };
+    cell_t multi;
+  };
   const void *code;
 } BUILTIN_WORD;
 
@@ -100,11 +105,11 @@ typedef struct {
   X("R>", FROMR, DUP; tos = *rp; --rp) \
   X("R@", RAT, DUP; tos = *rp) \
   Y(EXECUTE, w = tos; DROP; JMPW) \
-  Y(BRANCH, ip = (cell_t *) *ip) \
+  YV(internals, BRANCH, ip = (cell_t *) *ip) \
-  Y(0BRANCH, if (!tos) ip = (cell_t *) *ip; else ++ip; DROP) \
+  YV(internals, 0BRANCH, if (!tos) ip = (cell_t *) *ip; else ++ip; DROP) \
-  Y(DONEXT, *rp = *rp - 1; if (~*rp) ip = (cell_t *) *ip; else (--rp, ++ip)) \
+  YV(internals, DONEXT, *rp = *rp - 1; if (~*rp) ip = (cell_t *) *ip; else (--rp, ++ip)) \
-  Y(DOLIT, DUP; tos = *ip++) \
+  YV(internals, DOLIT, DUP; tos = *ip++) \
-  Y(ALITERAL, COMMA(g_sys.DOLIT_XT); COMMA(tos); DROP) \
+  YV(internals, ALITERAL, COMMA(g_sys.DOLIT_XT); COMMA(tos); DROP) \
   Y(CELL, DUP; tos = sizeof(cell_t)) \
   Y(FIND, tos = find((const char *) *sp, tos); --sp) \
   Y(PARSE, DUP; tos = parse(tos, sp)) \
@@ -117,7 +122,7 @@ typedef struct {
   X("DOES>", DOES, DOES(ip); ip = (cell_t *) *rp; --rp) \
   Y(IMMEDIATE, DOIMMEDIATE()) \
   XV(internals, "'SYS", SYS, DUP; tos = (cell_t) &g_sys) \
-  Y(YIELD, PARK; return rp) \
+  YV(internals, YIELD, PARK; return rp) \
   X(":", COLON, DUP; DUP; tos = parse(32, sp); \
                 create((const char *) *sp, tos, SMUDGE, ADDR_DOCOLON); \
                 g_sys.state = -1; --sp; DROP) \
@@ -125,5 +130,5 @@ typedef struct {
                sp = evaluate1(sp, &tfp); \
                fp = tfp; w = *sp--; DROP; if (w) JMPW) \
   Y(EXIT, ip = (cell_t *) *rp--) \
-  XV(internals, "'builtins", TBUILTINS, DUP; tos = (cell_t) g_sys.builtins) \
+  XV(internals, "'builtins", TBUILTINS, DUP; tos = (cell_t) &g_sys.builtins->code) \
   XV(forth_immediate, ";", SEMICOLON, COMMA(g_sys.DOEXIT_XT); UNSMUDGE(); g_sys.state = 0)

ueforth/common/utils.fs

@@ -108,7 +108,7 @@ internals definitions
    line-pos line-width > if cr 0 to line-pos then
    dup >name nip 1+ line-pos + to line-pos ;
 : vins. ( voc -- )
-  >r 'builtins 2 cells + begin dup 2 cells - @ while
+  >r 'builtins begin dup >link while
     dup >params r@ = if dup onlines see. then
     3 cells +
   repeat drop rdrop ;
@@ -116,9 +116,9 @@ internals definitions
 : ?ins. ( xt -- xt ) dup >flags BUILTIN_FORK and if dup ins. then ;
 forth definitions also internals
 : vlist   0 to line-pos context @ @
-          begin dup nonvoc? while onlines dup ?ins. see. >link repeat drop cr ;
+          begin dup nonvoc? while ?ins. dup onlines see. >link repeat drop cr ;
 : words   0 to line-pos context @ @
-          begin dup while onlines dup see. >link repeat drop cr ;
+          begin dup while ?ins. dup onlines see. >link repeat drop cr ;
 only forth definitions
 
 ( Extra Task Utils )

ueforth/common/vocabulary.fs

@@ -50,10 +50,9 @@ variable scope   scope context cell - !
 transfer{
   xt-find& xt-hide xt-transfer
   voc-stack-end last-vocabulary
-  yield branch 0branch donext dolit
   'context 'notfound notfound
   immediate? input-buffer ?echo ?arrow. arrow
-  evaluate1 evaluate-buffer
+  evaluate-buffer
   'sys 'heap aliteral 'heap-start 'heap-size
   'stack-cells 'boot 'boot-size 'latestxt
   'argc 'argv 'runner 'tib

ueforth/esp32/platform.fs

@@ -14,7 +14,6 @@
 
 ( Add a yielding task so pause yields )
 internals definitions
-transfer{ raw-yield }transfer
 : yield-step   raw-yield yield ;
 ' yield-step 100 100 task yield-task
 yield-task start-task

ueforth/windows/interp.h

@@ -38,6 +38,7 @@ static cell_t *forth_run(cell_t *init_rp) {
     EXTRA_OPCODE_LIST
     OPCODE_LIST
 #undef XV
+    0, 0, 0,
   };
 
   if (!init_rp) {