Fix issue with sizes in colon words + see.
This commit is contained in:
@ -123,12 +123,16 @@ static cell_t find(const char *name, cell_t len) {
|
|||||||
return 0;
|
return 0;
|
||||||
}
|
}
|
||||||
|
|
||||||
static void create(const char *name, cell_t nlength, cell_t flags, void *op) {
|
static void finish(void) {
|
||||||
if (g_sys.latestxt) {
|
if (g_sys.latestxt && !(g_sys.latestxt[-1] >> 16)) {
|
||||||
cell_t sz = g_sys.heap - &g_sys.latestxt[1];
|
cell_t sz = g_sys.heap - &g_sys.latestxt[1];
|
||||||
if (sz < 0 || sz > 0xffff) { sz = 0xffff; }
|
if (sz < 0 || sz > 0xffff) { sz = 0xffff; }
|
||||||
g_sys.latestxt[-1] |= (sz << 16);
|
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);
|
g_sys.heap = (cell_t *) CELL_ALIGNED(g_sys.heap);
|
||||||
char *pos = (char *) g_sys.heap;
|
char *pos = (char *) g_sys.heap;
|
||||||
for (cell_t n = nlength; n; --n) { *pos++ = *name++; } // name
|
for (cell_t n = nlength; n; --n) { *pos++ = *name++; } // name
|
||||||
|
|||||||
@ -29,7 +29,7 @@ typedef uintptr_t ucell_t;
|
|||||||
#define PUSH DUP; tos = (cell_t)
|
#define PUSH DUP; tos = (cell_t)
|
||||||
#define COMMA(n) *g_sys.heap++ = (n)
|
#define COMMA(n) *g_sys.heap++ = (n)
|
||||||
#define DOIMMEDIATE() (*g_sys.current)[-1] |= IMMEDIATE
|
#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 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
|
#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); \
|
sp = evaluate1(sp, &tfp); \
|
||||||
fp = tfp; w = *sp--; DROP; if (w) JMPW) \
|
fp = tfp; w = *sp--; DROP; if (w) JMPW) \
|
||||||
Y(EXIT, ip = (cell_t *) *rp--) \
|
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)
|
||||||
|
|||||||
@ -52,8 +52,8 @@ internals definitions
|
|||||||
over ['] DONEXT = or
|
over ['] DONEXT = or
|
||||||
if see. cell+ exit then
|
if see. cell+ exit then
|
||||||
see. ;
|
see. ;
|
||||||
: exit= ( xt -- ) ['] exit = ;
|
: see-loop dup >body swap >params 1- cells over +
|
||||||
: see-loop >body begin dup @ exit= 0= while see-one repeat drop ;
|
begin 2dup < while swap see-one swap repeat 2drop ;
|
||||||
: see-xt ( xt -- )
|
: see-xt ( xt -- )
|
||||||
dup @ ['] see-loop @ <>
|
dup @ ['] see-loop @ <>
|
||||||
if ." Unsupported word type: " see. cr exit then
|
if ." Unsupported word type: " see. cr exit then
|
||||||
|
|||||||
Reference in New Issue
Block a user