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

Tweaks towards web version working, again...

Browse Source
This commit is contained in:
Brad Nelson
2022-07-10 13:43:07 -07:00
parent a7f25d8819
commit ddd878ae20
9 changed files with 75 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
common/extra_opcodes.h
View File

@ -15,11 +15,11 @@
#define EXTRA_OPCODE_LIST \
Y(nip, NIP) \
Y(rdrop, --rp) \
X("*/", STARSLASH, SSMOD_FUNC; NIP) \
XV(forth, "*/", STARSLASH, SSMOD_FUNC; NIP) \
X("*", STAR, tos *= *sp--) \
X("/mod", SLASHMOD, DUP; *sp = 1; SSMOD_FUNC) \
X("/", SLASH, DUP; *sp = 1; SSMOD_FUNC; NIP) \
Y(mod, DUP; *sp = 1; SSMOD_FUNC; DROP) \
XV(forth, "/mod", SLASHMOD, DUP; *sp = 1; SSMOD_FUNC) \
XV(forth, "/", SLASH, DUP; *sp = 1; SSMOD_FUNC; NIP) \
XV(forth, "mod", mod, DUP; *sp = 1; SSMOD_FUNC; DROP) \
Y(invert, tos = ~tos) \
Y(negate, tos = -tos) \
X("-", MINUS, tos = (*sp--) - tos) \
@ -37,14 +37,14 @@
Y(nl, DUP; tos = '\n') \
X("1+", ONEPLUS, ++tos) \
X("1-", ONEMINUS, --tos) \
X("2*", TWOSTAR, tos <<= 1) \
X("2/", TWOSLASH, tos >>= 1) \
X("4*", FOURSTAR, tos <<= 2) \
X("4/", FOURSLASH, tos >>= 2) \
X("2*", TWOSTAR, tos = tos << 1) \
X("2/", TWOSLASH, tos = tos >> 1) \
X("4*", FOURSTAR, tos = tos << 2) \
X("4/", FOURSLASH, tos = tos >> 2) \
X("+!", PLUSSTORE, *(cell_t *) tos += *sp--; DROP) \
X("cell+", CELLPLUS, tos += sizeof(cell_t)) \
X("cells", CELLSTAR, tos *= sizeof(cell_t)) \
X("cell/", CELLSLASH, DUP; tos = sizeof(cell_t); DUP; *sp = 1; SSMOD_FUNC; NIP) \
XV(forth, "cell/", CELLSLASH, DUP; tos = sizeof(cell_t); DUP; *sp = 1; SSMOD_FUNC; NIP) \
X("2drop", TWODROP, NIP; DROP) \
X("2dup", TWODUP, DUP; tos = sp[-1]; DUP; tos = sp[-1]) \
X("2@", TWOAT, DUP; *sp = *(cell_t *) tos; tos = ((cell_t *) tos)[1]) \
@ -62,9 +62,8 @@
Y(allot, g_sys.heap = (cell_t *) (tos + (cell_t) g_sys.heap); DROP) \
Y(aligned, tos = CELL_ALIGNED(tos)) \
Y(align, g_sys.heap = (cell_t *) CELL_ALIGNED(g_sys.heap)) \
X(",", COMMA, *g_sys.heap++ = tos; DROP) \
X("c,", CCOMMA, *((uint8_t *) g_sys.heap) = tos; DROP; \
g_sys.heap = (cell_t *) (1 + ((cell_t) g_sys.heap))) \
XV(forth, ",", COMMA, COMMA(tos); DROP) \
XV(forth, "c,", CCOMMA, CCOMMA(tos); DROP) \
X(">flags", TOFLAGS, tos = *TOFLAGS(tos)) \
X(">params", TOPARAMS, tos = *TOPARAMS(tos)) \
X(">size", TOSIZE, tos = TOSIZE(tos)) \

20
common/floats.h
View File

@ -15,7 +15,7 @@
#include <math.h>
#define FLOATING_POINT_LIST \
YV(internals, DOFLIT, *++fp = *(float *) ip++) \
YV(internals, DOFLIT, *++fp = *(float *) ip; ++ip) \
X("FP@", FPAT, DUP; tos = (cell_t) fp) \
X("FP!", FPSTORE, fp = (float *) tos; DROP) \
X("SF@", FAT, *++fp = *(float *) tos; DROP) \
@ -24,21 +24,21 @@
Y(FNIP, fp[-1] = *fp; --fp) \
Y(FDROP, --fp) \
Y(FOVER, fp[1] = fp[-1]; ++fp) \
Y(FSWAP, float ft = fp[-1]; fp[-1] = *fp; *fp = ft) \
Y(FROT, float ft = fp[-2]; fp[-2] = fp[-1]; fp[-1] = *fp; *fp = ft) \
Y(FSWAP, ft = fp[-1]; fp[-1] = *fp; *fp = ft) \
Y(FROT, ft = fp[-2]; fp[-2] = fp[-1]; fp[-1] = *fp; *fp = ft) \
Y(FNEGATE, *fp = -*fp) \
X("F0<", FZLESS, DUP; tos = *fp-- < 0.0f ? -1 : 0) \
X("F0=", FZEQUAL, DUP; tos = *fp-- == 0.0f ? -1 : 0) \
X("F0<", FZLESS, DUP; tos = *fp < 0.0f ? -1 : 0; --fp) \
X("F0=", FZEQUAL, DUP; tos = *fp == 0.0f ? -1 : 0; --fp) \
X("F=", FEQUAL, DUP; tos = fp[-1] == fp[0] ? -1 : 0; fp -= 2) \
X("F<", FLESS, DUP; tos = fp[-1] < fp[0] ? -1 : 0; fp -= 2) \
X("F>", FGREATER, DUP; tos = fp[-1] > fp[0] ? -1 : 0; fp -= 2) \
X("F<>", FNEQUAL, DUP; tos = fp[-1] != fp[0] ? -1 : 0; fp -= 2) \
X("F<=", FLESSEQ, DUP; tos = fp[-1] <= fp[0] ? -1 : 0; fp -= 2) \
X("F>=", FGREATEREQ, DUP; tos = fp[-1] >= fp[0] ? -1 : 0; fp -= 2) \
X("F+", FPLUS, fp[-1] += *fp; --fp) \
X("F-", FMINUS, fp[-1] -= *fp; --fp) \
X("F*", FSTAR, fp[-1] *= *fp; --fp) \
X("F/", FSLASH, fp[-1] /= *fp; --fp) \
X("F+", FPLUS, fp[-1] = fp[-1] + *fp; --fp) \
X("F-", FMINUS, fp[-1] = fp[-1] - *fp; --fp) \
X("F*", FSTAR, fp[-1] = fp[-1] * *fp; --fp) \
X("F/", FSLASH, fp[-1] = fp[-1] / *fp; --fp) \
X("1/F", FINVERSE, *fp = 1.0 / *fp) \
X("S>F", STOF, *++fp = (float) tos; DROP) \
X("F>S", FTOS, DUP; tos = (cell_t) *fp--) \
@ -46,7 +46,7 @@
Y(SFLOAT, DUP; tos = sizeof(float)) \
Y(SFLOATS, tos *= sizeof(float)) \
X("SFLOAT+", SFLOATPLUS, tos += sizeof(float)) \
X("PI", PI_CONST, *++fp = 3.14159265359f) \
X("PI", PI_CONST, *++fp = (float) 3.14159265359) \
Y(FSIN, *fp = sin(*fp)) \
Y(FCOS, *fp = cos(*fp)) \
Y(FSINCOS, fp[1] = cos(*fp); *fp = sin(*fp); ++fp) \

2
common/interp.h
View File

@ -34,7 +34,7 @@ static cell_t *forth_run(cell_t *init_rp) {
return 0;
}
register cell_t *ip, *rp, *sp, tos, w;
register float *fp;
register float *fp, ft;
rp = init_rp; UNPARK; NEXT;
#define XV(flags, name, op, code) OP_ ## op: { code; } NEXT;
PLATFORM_OPCODE_LIST

11
common/opcodes.h
View File

@ -31,6 +31,7 @@ typedef uintptr_t ucell_t;
#define DUP (*++sp = tos)
#define PUSH DUP; tos = (cell_t)
#define COMMA(n) *g_sys.heap++ = (n)
#define CCOMMA(n) *(uint8_t *) g_sys.heap = (n); g_sys.heap = (cell_t *) (1 + ((cell_t) g_sys.heap));
#define DOES(ip) **g_sys.current = (cell_t) ADDROF(DODOES); (*g_sys.current)[1] = (cell_t) ip
#define PARK DUP; *++rp = (cell_t) fp; *++rp = (cell_t) sp; *++rp = (cell_t) ip
@ -80,10 +81,10 @@ typedef struct {
X("+", PLUS, tos += *sp--) \
X("U/MOD", USMOD, w = *sp; *sp = (ucell_t) w % (ucell_t) tos; \
tos = (ucell_t) w / (ucell_t) tos) \
X("*/MOD", SSMOD, SSMOD_FUNC) \
Y(LSHIFT, tos = (*sp-- << tos)) \
Y(RSHIFT, tos = (((ucell_t) *sp--) >> tos)) \
Y(ARSHIFT, tos = (*sp-- >> tos)) \
XV(forth, "*/MOD", SSMOD, SSMOD_FUNC) \
Y(LSHIFT, tos = (*sp << tos); --sp) \
Y(RSHIFT, tos = (((ucell_t) *sp) >> tos); --sp) \
Y(ARSHIFT, tos = (*sp >> tos); --sp) \
Y(AND, tos &= *sp--) \
Y(OR, tos |= *sp--) \
Y(XOR, tos ^= *sp--) \
@ -113,7 +114,7 @@ typedef struct {
YV(internals, 0BRANCH, if (!tos) ip = (cell_t *) *ip; else ++ip; DROP) \
YV(internals, DONEXT, *rp = *rp - 1; if (~*rp) ip = (cell_t *) *ip; else (--rp, ++ip)) \
YV(internals, DOLIT, DUP; tos = *ip++) \
YV(internals, DOSET, *((cell_t *) *ip++) = tos; DROP) \
YV(internals, DOSET, *((cell_t *) *ip) = tos; ++ip; DROP) \
YV(internals, DOCOL, ++rp; *rp = (cell_t) ip; ip = (cell_t *) (w + sizeof(cell_t))) \
YV(internals, DOCON, DUP; tos = *(cell_t *) (w + sizeof(cell_t))) \
YV(internals, DOVAR, DUP; tos = w + sizeof(cell_t)) \