diff --git a/ueforth/common/core.h b/ueforth/common/core.h index 4d05ed1..7c8589a 100644 --- a/ueforth/common/core.h +++ b/ueforth/common/core.h @@ -21,6 +21,7 @@ #define CELL_ALIGNED(a) ((((cell_t) (a)) + CELL_MASK) & ~CELL_MASK) #define IMMEDIATE 1 #define SMUDGE 2 +#define BUILTIN_FORK 4 // Maximum ALSO layers. #define VOCABULARY_DEPTH 16 @@ -45,6 +46,7 @@ static struct { // Layout not used by Forth. cell_t *rp; // spot to park main thread cell_t DOLIT_XT, DOFLIT_XT, DOEXIT_XT, YIELD_XT; + const BUILTIN_WORD *builtins; } g_sys; static cell_t convert(const char *pos, cell_t n, cell_t base, cell_t *ret) { @@ -112,8 +114,15 @@ static cell_t find(const char *name, cell_t len) { for (cell_t ***voc = g_sys.context; *voc; ++voc) { cell_t xt = (cell_t) **voc; while (xt) { - if (!(*TOFLAGS(xt) & SMUDGE) && len == *TONAMELEN(xt) && - same(name, TONAME(xt), len)) { + if ((*TOFLAGS(xt) & BUILTIN_FORK)) { + for (int i = 0; g_sys.builtins[i].name; ++i) { + if (len == g_sys.builtins[i].name_length && + same(name, g_sys.builtins[i].name, len)) { + return (cell_t) &g_sys.builtins[i].code; + } + } + } else if (!(*TOFLAGS(xt) & SMUDGE) && len == *TONAMELEN(xt) && + same(name, TONAME(xt), len)) { return xt; } xt = *TOLINK(xt); diff --git a/ueforth/common/forth_namespace_tests.fs b/ueforth/common/forth_namespace_tests.fs index 30c3434..1035539 100644 --- a/ueforth/common/forth_namespace_tests.fs +++ b/ueforth/common/forth_namespace_tests.fs @@ -201,7 +201,6 @@ e: check-extra-opcodes e: check-core-opcodes out: ; - out: foo out: EXIT out: : out: IMMEDIATE diff --git a/ueforth/common/interp.h b/ueforth/common/interp.h index 2e9fcf6..2e8d74f 100644 --- a/ueforth/common/interp.h +++ b/ueforth/common/interp.h @@ -19,19 +19,18 @@ #define ADDR_DODOES && OP_DODOES static cell_t *forth_run(cell_t *init_rp) { - static const struct { - const char *name; - cell_t flags; - const void *code; - } foo[] = { -#define XV(flags, name, op, code) name, flags, && OP_ ## op, + static const BUILTIN_WORD builtins[] = { +#define XV(flags, name, op, code) \ + name, 0, sizeof(name) - 1, (flags & 0xff), && OP_ ## op, PLATFORM_OPCODE_LIST EXTRA_OPCODE_LIST OPCODE_LIST #undef XV + 0, 0, 0, }; 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 diff --git a/ueforth/common/opcodes.h b/ueforth/common/opcodes.h index d3465f3..2964852 100644 --- a/ueforth/common/opcodes.h +++ b/ueforth/common/opcodes.h @@ -61,6 +61,11 @@ typedef int64_t dcell_t; #endif enum { FORTH = 0, INTERNALS }; +typedef struct { + const char *name; + uint8_t flags, name_length, vocabulary; + const void *code; +} BUILTIN_WORD; #define OPCODE_LIST \ X("0=", ZEQUAL, tos = !tos ? -1 : 0) \ @@ -119,5 +124,4 @@ enum { FORTH = 0, INTERNALS }; sp = evaluate1(sp, &tfp); \ fp = tfp; w = *sp--; DROP; if (w) JMPW) \ Y(EXIT, ip = (cell_t *) *rp--) \ - Y(foo, DUP; tos = (cell_t) foo) \ X(";", SEMICOLON, COMMA(g_sys.DOEXIT_XT); UNSMUDGE(); g_sys.state = 0) diff --git a/ueforth/windows/interp.h b/ueforth/windows/interp.h index bab906c..6d25c24 100644 --- a/ueforth/windows/interp.h +++ b/ueforth/windows/interp.h @@ -30,12 +30,9 @@ enum { }; static cell_t *forth_run(cell_t *init_rp) { - static const struct { - const char *name; - cell_t flags; - const void *code; - } foo[] = { -#define XV(flags, name, op, code) name, 0, (void *) OP_ ## op, + static const BUILTIN_WORD builtins[] = { +#define XV(flags, name, op, code) \ + name, 0, sizeof(name) - 1, (flags & 0xff), (void *) OP_ ## op, PLATFORM_OPCODE_LIST EXTRA_OPCODE_LIST OPCODE_LIST @@ -43,6 +40,7 @@ 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