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

Fix issue with sizes in colon words + see.

Browse Source
This commit is contained in:
Brad Nelson
2022-02-02 20:04:02 -08:00
parent b1fb668395
commit 6fbff7131c
3 changed files with 10 additions and 6 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
ueforth/common/core.h
View File

@ -123,12 +123,16 @@ static cell_t find(const char *name, cell_t len) {
return 0;
}
static void create(const char *name, cell_t nlength, cell_t flags, void *op) {
if (g_sys.latestxt) {
static void finish(void) {
if (g_sys.latestxt && !(g_sys.latestxt[-1] >> 16)) {
cell_t sz = g_sys.heap - &g_sys.latestxt[1];
if (sz < 0 || sz > 0xffff) { sz = 0xffff; }
g_sys.latestxt[-1] |= (sz << 16);
}
}
static void create(const char *name, cell_t nlength, cell_t flags, void *op) {
finish();
g_sys.heap = (cell_t *) CELL_ALIGNED(g_sys.heap);
char *pos = (char *) g_sys.heap;
for (cell_t n = nlength; n; --n) { *pos++ = *name++; } // name

4
ueforth/common/opcodes.h
View File

@ -29,7 +29,7 @@ typedef uintptr_t ucell_t;
#define PUSH DUP; tos = (cell_t)
#define COMMA(n) *g_sys.heap++ = (n)
#define DOIMMEDIATE() (*g_sys.current)[-1] |= IMMEDIATE
#define UNSMUDGE() (*g_sys.current)[-1] &= ~SMUDGE
#define UNSMUDGE() (*g_sys.current)[-1] &= ~SMUDGE; finish()
#define DOES(ip) **g_sys.current = (cell_t) ADDR_DODOES; (*g_sys.current)[1] = (cell_t) ip
#define PARK DUP; *++rp = (cell_t) fp; *++rp = (cell_t) sp; *++rp = (cell_t) ip
@ -105,4 +105,4 @@ typedef int64_t dcell_t;
sp = evaluate1(sp, &tfp); \
fp = tfp; w = *sp--; DROP; if (w) JMPW) \
Y(EXIT, ip = (cell_t *) *rp--) \
X(";", SEMICOLON, UNSMUDGE(); COMMA(g_sys.DOEXIT_XT); g_sys.state = 0)
X(";", SEMICOLON, COMMA(g_sys.DOEXIT_XT); UNSMUDGE(); g_sys.state = 0)

4
ueforth/common/utils.fs
View File

@ -52,8 +52,8 @@ internals definitions
over ['] DONEXT = or
if see. cell+ exit then
see. ;
: exit= ( xt -- ) ['] exit = ;
: see-loop >body begin dup @ exit= 0= while see-one repeat drop ;
: see-loop dup >body swap >params 1- cells over +
begin 2dup < while swap see-one swap repeat 2drop ;
: see-xt ( xt -- )
dup @ ['] see-loop @ <>
if ." Unsupported word type: " see. cr exit then