|
|
|
@ -16,8 +16,6 @@
|
|
|
|
|
|
|
|
|
|
#include "foci.h"
|
|
|
|
|
|
|
|
|
|
#include <stdlib.h> // strtol
|
|
|
|
|
|
|
|
|
|
#define END_OF(arr) ((arr) + (sizeof((arr)) / sizeof(*(arr))))
|
|
|
|
|
|
|
|
|
|
static intptr_t dstack[32];
|
|
|
|
@ -26,7 +24,7 @@ static intptr_t dict[8192] = {
|
|
|
|
|
0, 10
|
|
|
|
|
};
|
|
|
|
|
#define state dict[0]
|
|
|
|
|
#define base dict[1]
|
|
|
|
|
#define BASE dict[1]
|
|
|
|
|
#define begin dict[2]
|
|
|
|
|
static intptr_t *here = &begin;
|
|
|
|
|
static struct word_t *latest;
|
|
|
|
@ -71,19 +69,23 @@ int compare(const char *a, const char *b, int l)
|
|
|
|
|
return 0;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
struct word_t *lookup_p(const char *s, int len)
|
|
|
|
|
{
|
|
|
|
|
for (struct word_t *l = latest; l; l = l->prev) {
|
|
|
|
|
if (len == (l->attr & ATTR_LEN) && !compare(s, l->name, len))
|
|
|
|
|
return l;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return 0;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
NAKED
|
|
|
|
|
void lookup()
|
|
|
|
|
{
|
|
|
|
|
static struct word_t *l;
|
|
|
|
|
|
|
|
|
|
STASH;
|
|
|
|
|
for (l = latest; l; l = l->prev) {
|
|
|
|
|
if (*(char *)here == (l->attr & ATTR_LEN) &&
|
|
|
|
|
!compare((char *)((intptr_t)here + 1), l->name, *(char *)here))
|
|
|
|
|
{
|
|
|
|
|
break;
|
|
|
|
|
}
|
|
|
|
|
}
|
|
|
|
|
l = lookup_p((char *)((intptr_t)here + 1), *(char *)here);
|
|
|
|
|
RESTORE;
|
|
|
|
|
|
|
|
|
|
*--sp = (intptr_t)l;
|
|
|
|
@ -116,7 +118,8 @@ W(cell, "cell", &w_comma) LIT(sizeof(*sp)), END
|
|
|
|
|
W(cellp, "cell+", &w_cell) FTH(cell), add, END
|
|
|
|
|
W(cells, "cells", &w_cellp) FTH(cell), mul, END
|
|
|
|
|
W(dict, "_d", &w_cells) LIT(dict), END
|
|
|
|
|
W(here, "here", &w_dict) LIT(&here), peek, END
|
|
|
|
|
W(base, "base", &w_dict) LIT(&BASE), END
|
|
|
|
|
W(here, "here", &w_base) LIT(&here), peek, END
|
|
|
|
|
W(allot, "allot", &w_here) LIT(&here), FTH(addto), END
|
|
|
|
|
W(latest, "latest", &w_allot) LIT(&latest), peek, END
|
|
|
|
|
W(negate, "negate", &w_latest) LIT(-1), mul, END
|
|
|
|
@ -138,7 +141,9 @@ I(then, "then", &w_fif) FTH(here), LIT(sizeof(intptr_t)), sub, swap, pok
|
|
|
|
|
I(felse, "else", &w_then) LIT(b), comma, FTH(here), LIT(0), comma, swap, FTH(then), END
|
|
|
|
|
W(tick, "\'", &w_felse) compname, drop, lookup, peek, END
|
|
|
|
|
N(execute, "execute", &w_tick) { pp = (intptr_t **)*sp++ - 1; NEXT; }
|
|
|
|
|
#define LATEST &w_execute
|
|
|
|
|
W(decimal, "decimal", &w_execute) LIT(10), LIT(&BASE), poke, END
|
|
|
|
|
W(hex, "hex", &w_decimal) LIT(16), LIT(&BASE), poke, END
|
|
|
|
|
#define LATEST &w_hex
|
|
|
|
|
|
|
|
|
|
void call(void *ptr)
|
|
|
|
|
{
|
|
|
|
@ -146,14 +151,27 @@ void call(void *ptr)
|
|
|
|
|
((void (*)())*pp)();
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
struct word_t *lookup_p(const char *s, int len)
|
|
|
|
|
intptr_t parse_number(const char *s, const char **endp, int b)
|
|
|
|
|
{
|
|
|
|
|
for (struct word_t *l = latest; l; l = l->prev) {
|
|
|
|
|
if (len == (l->attr & ATTR_LEN) && !compare(s, l->name, len))
|
|
|
|
|
return l;
|
|
|
|
|
intptr_t n = 0;
|
|
|
|
|
int neg;
|
|
|
|
|
|
|
|
|
|
if (*s == '-') {
|
|
|
|
|
neg = 1;
|
|
|
|
|
s++;
|
|
|
|
|
} else {
|
|
|
|
|
neg = 0;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
return 0;
|
|
|
|
|
while (*s >= '0' && *s <= " 0123456789abcdef"[b]) {
|
|
|
|
|
n *= b;
|
|
|
|
|
n += *s;
|
|
|
|
|
n -= *s <= '9' ? '0' : ('a' - 10);
|
|
|
|
|
s++;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
*endp = s;
|
|
|
|
|
return neg ? n * -1 : n;
|
|
|
|
|
}
|
|
|
|
|
|
|
|
|
|
void parse_word(const char *buf, const char *s)
|
|
|
|
@ -166,8 +184,8 @@ void parse_word(const char *buf, const char *s)
|
|
|
|
|
pp = saved_pp;
|
|
|
|
|
|
|
|
|
|
if (l == 0) {
|
|
|
|
|
char *end;
|
|
|
|
|
long n = strtol(buf, &end, base);
|
|
|
|
|
const char *end;
|
|
|
|
|
intptr_t n = parse_number(buf, &end, BASE);
|
|
|
|
|
if (*end == '\0') {
|
|
|
|
|
if (state) {
|
|
|
|
|
*here++ = (intptr_t)push;
|
|
|
|
|