alx/ueforth
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Builtins now internals, but vlist skips them.

Browse Source
This commit is contained in:
Brad Nelson
2022-02-06 15:04:28 -08:00
parent 84d13d941c
commit ba1db93e62
7 changed files with 29 additions and 28 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
ueforth/common/core.h
View File

@ -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");

17
ueforth/common/forth_namespace_tests.fs
View File

@ -397,9 +397,9 @@ e: check-phase1
check-vocabulary
check-[]conds
check-boot
check-core-opcodes
check-extra-opcodes
check-float-opcodes
\ check-core-opcodes
\ check-extra-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: GETPROCADDRESS
\ out: LOADLIBRARYA
\ 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]

8
ueforth/common/interp.h
View File

@ -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;

6
ueforth/common/opcodes.h
View File

@ -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)

5
ueforth/common/utils.fs
View File

@ -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 + @ ;

6
ueforth/common/vocabulary.fs
View File

@ -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

9
ueforth/windows/interp.h
View File

@ -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;