commit 791e4644aadfd0e48e370077563e76d1213e19e9 Author: Jeremy Penner Date: Fri Sep 1 19:10:50 2023 -0400 First cut at stripping down minijort diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..c440dfc --- /dev/null +++ b/.gitignore @@ -0,0 +1,4 @@ +*.bak +*.obj +*.dsk + diff --git a/boot.jor b/boot.jor new file mode 100755 index 0000000..d0b75d9 --- /dev/null +++ b/boot.jor @@ -0,0 +1,66 @@ +0 const 0 +1 const 1 +2 const cell +: cells cell * ; + +10 const '\n' +13 const '\r' +key const sp + +128 const F_IMMEDIATE +0x100 const F_USERWORD + +: cr '\n' emit ; +: bl sp emit ; + +: if ' BZ_ , here 0 , ; immediate +: else ' GOTO_ , 0 , here swap ! here cell - ; immediate +: then here swap ! ; immediate + +: begin here ; immediate +: while ' BZ_ , here 0 , ; immediate +: repeat ' GOTO_ , swap , here swap ! ; immediate +: again ' GOTO_ , , ; immediate +: until ' BZ_ , , ; immediate + +: lit ' LIT_ , , ; +: ( begin key [ key ) lit ] = until ; immediate + +: inline| ' INLINEDATA_ , here 0 , ; +: |inline [ ' then , ] ; + +' cells @ const $DOCOLON ( get the colon execution token ) +: :| inline| $DOCOLON , ; immediate +: |; ' ret , |inline ; immediate + +: s" state if inline| else here then + begin key dup [ key " lit ] != over 0 != and while b, repeat drop 0 b, + state if |inline else dup here! then ; immediate + +: interpretword F_IMMEDIATE & state not or if execute else , then ; +: interpretnumber state if lit then ; +: interpretunknown type s" ?" type cr ; +: compileword lookup dup + if interpretword + else drop number + if interpretnumber + else interpretunknown + then + then ; +: interpreter + begin word dup b@ while compileword repeat drop ; +: loadfp ( -- ) + infile @ >r + fdeactivate infile ! + interpreter + infile @ factivate + r open loadfp close +#include +#include +#include +#include +#include "minijort.h" + +#define STACK_OFFSET 0 +#define RSTACK_OFFSET STACK_SIZE + +char mem[MEM_SIZE] = { 0 }; +cell *HERE = ((cell*)mem) + STACK_SIZE + RSTACK_SIZE; +cell *LATEST = NULL; +cell IP = NULL; +cell W = NULL; +cell STATE = 0; +cell *stack = ((cell*)mem); +cell *rstack = ((cell*)mem) + STACK_SIZE; +#ifdef TRACE +int TRACING = 0; +#endif + +FILE *ACTIVE_FILE = NULL; +FILE *IN_FILE = stdin; +FILE *OUT_FILE = stdout; + +void DROP(n) { + stack -= n; + if (stack < mem + STACK_OFFSET) { + stack = mem + STACK_OFFSET; + PUSHS("underflow!\n"); + f_puts(); + } +} + +void PUSHC(cell c) { *stack = c; stack++; } +void PUSHI(int i) { stack->i = i; stack++; } +void PUSHU(unsigned int u) { stack->u = u; stack++; } +void PUSHCP(cell *c) { stack->p = c; stack++; } +void PUSHS(char *s) { stack->s = s; stack++; } +void RPUSH(cell c) { *rstack = c; rstack++; } + +void f_here() { + PUSHCP(HERE); +} + +void f_here_set() { + HERE = TOP().p; + DROP(1); +} +void f_there() { + PUSHCP(&mem[MEM_SIZE]); +} + +void f_latest() { + PUSHCP(LATEST); +} + +void f_latest_set() { + LATEST = TOP().p; + DROP(1); +} + +void f_state() { + PUSHC(STATE); +} + +#define BINOP(name, type, op) \ + void name() { \ + cell r = TOP(); \ + DROP(1); \ + TOP().type = TOP().type op r.type; \ + } + +BINOP(f_add, i, +) +BINOP(f_sub, i, -) +BINOP(f_mul, i, *) +BINOP(f_div, i, /) +BINOP(f_mod, u, %) +BINOP(f_eq, i, ==) +BINOP(f_neq, i, !=) +BINOP(f_ge, i, >=) +BINOP(f_gt, i, >) +BINOP(f_lt, i, <) +BINOP(f_le, i, <=) +BINOP(f_uge, u, >=) +BINOP(f_ugt, u, >) +BINOP(f_ult, u, <) +BINOP(f_ule, u, <=) +BINOP(f_and, u, &&) +BINOP(f_or, u, ||) +BINOP(f_bitand, u, &) +BINOP(f_bitor, u, |) +BINOP(f_bitxor, u, ^) +BINOP(f_shr, u, >>) +BINOP(f_shl, u, <<) + +#define RATIO_FRACTIONAL_BITS 14 + +void f_toratio() { // a/b ( a b -- r ) + ST1().i = ((long)ST1().i * (1 << RATIO_FRACTIONAL_BITS)) / TOP().i; + DROP(1); +} + +void f_fromratio() { // a*r ( a r -- b ) + ST1().i = ((long)ST1().i * (long)TOP().i) / (1 << RATIO_FRACTIONAL_BITS); + DROP(1); +} + +void f_eq0() { + TOP().i = (TOP().i == 0); +} +void f_not() { + TOP().i = !TOP().i; +} + +void f_get() { + TOP() = (*(TOP().p)); +} + +void f_set() { + cell *p = TOP().p; + DROP(1); + (*p) = TOP(); + DROP(1); +} + +void f_bget() { + TOP().i = *((char*)TOP().p); +} + +void f_ubget() { + TOP().u = *((unsigned char*)TOP().p); +} + +void f_bset() { + char *p = (char*)TOP().p; + DROP(1); + (*p) = TOP().i; + DROP(1); +} + +void f_farset() { + *((cell far *)MK_FP(TOP().u, ST1().u)) = ST2(); + DROP(3); +} + +void f_farget() { + ST1() = *((cell far *)MK_FP(TOP().u, ST1().u)); + DROP(1); +} + +void f_farbset() { + *((char far *)MK_FP(TOP().u, ST1().u)) = ST2().i; + DROP(3); +} + +void f_farbget() { + ST1().i = *((char far *)MK_FP(TOP().u, ST1().u)); + DROP(1); +} + +void f_addset() { + TOP().p->i += ST1().i; + DROP(2); +} + +void f_drop() { + DROP(1); +} + +void f_dup() { + PUSHC(TOP()); +} + +void f_over() { + PUSHC(ST1()); +} + +void f_swap() { + cell top = TOP(); + cell st1 = ST1(); + TOP() = st1; + ST1() = top; +} + +void f_rot() { // a b c -- b c a + cell c = TOP(); + cell b = ST1(); + cell a = ST2(); + TOP() = a; + ST1() = c; + ST2() = b; +} + +void f_rput() { + RPUSH(TOP()); + DROP(1); +} + +void f_rtake() { + PUSHC(*RPOP()); +} + +void f_rtop() { + PUSHC(*(rstack - 1)); +} + +void f_rdrop() { + RPOP(); +} + +void f_rswap() { + cell top = *(rstack - 1); + cell under = *(rstack - 2); + *(rstack - 1) = under; + *(rstack - 2) = top; +} + +void f_cexecute(); + +void f_emit() { + if (OUT_FILE) { + fprintf(OUT_FILE, "%c", TOP().i); + } + DROP(1); +} + +void f_key() { + if (IN_FILE) { + PUSHI(fgetc(IN_FILE)); + } else { + PUSHI(EOF); + } +} + +void f_word() { + static char buf[32] = {0}; + int key = ' '; + int ibuf = 0; + + while (key == ' ' || key == '\t' || key == '\n' || key == '\r') { + f_key(); + key = TOP().i; + DROP(1); + } + + while (key != ' ' && key != '\t' && key != '\n' && key != '\r' && key != 0 && key != EOF) { + buf[ibuf++] = key; + f_key(); + key = TOP().i; + DROP(1); + } + buf[ibuf] = 0; + PUSHS(buf); +} + +void f_fputc() { + if (ACTIVE_FILE) { + fwrite(&TOP().i, 1, 1, ACTIVE_FILE); + } + DROP(1); +} + +void f_gets() { + gets(TOP().s); +} + +void f_fput() { + if (ACTIVE_FILE) { + fwrite(&TOP().u, 2, 1, ACTIVE_FILE); + } + DROP(1); +} + +void f_fwrite() { // ( length p ) + if (ACTIVE_FILE) { + fwrite(TOP().p, ST1().u, 1, ACTIVE_FILE); + } + DROP(2); +} + +void f_fgetc() { + int result = EOF; + if (ACTIVE_FILE) { + result = fgetc(ACTIVE_FILE); + } + PUSHI(result); +} + +void f_fget() { + unsigned int result = 0; + if (ACTIVE_FILE) { + int low = fgetc(ACTIVE_FILE); + int high = fgetc(ACTIVE_FILE); + if (low != EOF && high != EOF) { + result = low | (high << 8); + } + } + PUSHU(result); +} + +void f_fread() { // ( length p ) + if (ACTIVE_FILE) { + fread(TOP().p, ST1().u, 1, ACTIVE_FILE); + } + DROP(2); +} + +void f_feof() { + if (ACTIVE_FILE) { + PUSHI(feof(ACTIVE_FILE)); + } else { + PUSHI(1); + } +} + +void f_puts() { + char *s = TOP().s; + while (s && *s) { + PUSHI(*s); + f_emit(); + s++; + } + DROP(1); +} + +void f_dot() { + static char num[16]; + sprintf(num, "%d ", TOP().i); + TOP().s = num; + f_puts(); +} + +void f_udot() { + static char num[16]; + sprintf(num, "%u ", TOP().i); + TOP().s = num; + f_puts(); +} + +void f_printstack() { + cell *v = mem + STACK_OFFSET; + while (v != stack) { + PUSHC(*v++); + f_dot(); + } +} + +void f_printrstack() { + cell *v = mem + RSTACK_OFFSET; + while (v != rstack) { + PUSHC(*v++); + f_dot(); + } +} + +void f_cr() { + PUSHI('\n'); + f_emit(); +} + +void f_comma() { + *HERE++ = TOP(); + DROP(1); +} + +void f_allot() { + memset(HERE, 0, TOP().u); + HERE = CELL_OFFSET(HERE, TOP().u); + DROP(1); +} + +void f_bcomma() { + *((char*)HERE) = TOP().i; + HERE = CELL_OFFSET(HERE, 1); + DROP(1); +} + +void f_create() { // name -- + int namelen; + HERE->p = LATEST; + LATEST = HERE; + HERE++; + namelen = strlen(TOP().s); + HERE->u = namelen; HERE ++; + memcpy(HERE, TOP().s, namelen + 1); + HERE = CELL_OFFSET(HERE, namelen + 1); + DROP(1); +} + +void f_cdef() { // func name -- + f_create(); + f_comma(); +} + +void f_revlookup(); + +#ifdef TRACE +void f_traceon() { + TRACING = 1; +} +void f_traceoff() { + TRACING = 0; +} + +void f_colondispatch() { + static int printing = 0; + + if (TRACING && !printing) { + printing = 1; + PUSHCP(W.p); + f_revlookup(); + if (TOP().s) { + f_puts(); + PUSHU(' '); + f_emit(); + } else { + TOP().p = W.p; + f_dot(); + } + printing = 0; + } + W.p->f(); +} +#else +#define f_colondispatch() W.p->f() +#endif + +void f_colonloop() { + while (IP.p) { + W = *IP.p; + IP.p++; + f_colondispatch(); + } +} + +// this version of f_execute can be run from a colon word +void f_execute() { + W = TOP(); + DROP(1); + f_colondispatch(); +} + +// C code must always call a colon word through f_cexecute() +void f_cexecute() { + cell oldW = W; + cell oldIP = IP; + IP.p = NULL; + f_execute(); + f_colonloop(); + W = oldW; + IP = oldIP; +} + +void f_docolon() { + RPUSH(IP); + IP.p = W.p + 1; +} + +void f_dodeferred() { + W = *(W.p + 1); + f_colondispatch(); +} + +void f_lit_() { + PUSHC(*IP.p); + IP.p++; +} + +void f_number() { // str -- (num 1 | str 0) + int num = 0, result; + result = sscanf(TOP().s, "0x%x", &num); + if (result != 1) { + result = sscanf(TOP().s, "%d", &num); + } + if (result == 1) { + TOP().i = num; + PUSHI(result == 1); + } else { + PUSHI(0); + } +} + +void f_streq() { + int result = strcmp(TOP().s, ST1().s); + DROP(1); + TOP().i = result == 0; +} + +void f_wordname() { + TOP().p = TOP().p + 2; +} +void f_wordflags() { + TOP().p = TOP().p + 1; +} + +void f_codepointer() { + unsigned int flags = TOP().p[1].u; + TOP().p = CELL_OFFSET(TOP().p + 2, (flags & F_NAMELEN_MASK) + 1); +} + +void f_lookup() { // name -- (codepointer flags) | (name 0) + cell *entry = LATEST; + char *name = TOP().s; + int len = strlen(name); + DROP(1); + + while (entry) { + PUSHP(entry); + f_wordflags(); f_get(); + if (len == (TOP().u & F_NAMELEN_MASK)) { + PUSHS(name); + PUSHP(entry); + f_wordname(); + f_streq(); + if (TOP().i) { + TOP().p = entry; + f_codepointer(); + f_swap(); + return; + } + DROP(2); + } else { + DROP(1); + } + entry = entry->p; + } + PUSHS(name); + PUSHU(0); +} + +void f_revlookup() { // codepointer -- name + cell *entry = LATEST; + while (entry) { + PUSHCP(entry); + f_codepointer(); + if (TOP().p == ST1().p) { + DROP(1); + TOP().p = entry; + f_wordname(); + return; + } + DROP(1); + entry = entry->p; + } + TOP().p = NULL; +} + +void f_compileon() { + STATE.i = 1; +} +void f_compileoff() { + STATE.i = 0; +} + +void f_immediate() { + cell *flags = LATEST + 1; + flags->u |= F_IMMEDIATE; +} +void f_compileword(); + +void f_semicolon() { + PUSHS("ret"); + f_compileword(); + f_compileoff(); +} + +void f_ret() { + if (rstack == mem + RSTACK_OFFSET) { + IP.p = NULL; + } else { + IP = *RPOP(); + } +} + +void f_colon() { + f_word(); + f_create(); + PUSHP(f_docolon); + f_comma(); + f_compileon(); +} + +void f_interpretword() { // codefield flags -- + if (!STATE.i || (TOP().u & F_IMMEDIATE)) { + DROP(1); + f_cexecute(); + } else { + DROP(1); + f_comma(); + } +} + +void f_interpretnumber() { // number -- + if (STATE.i) { + PUSHS("LIT_"); + f_compileword(); + f_comma(); + } +} + +void f_interpretunknown() { // name -- + f_puts(); + PUSHS("?\n"); + f_puts(); +} + +void f_compileword() { // name -- + f_lookup(); + if (!TOP().u) { // name 0 + DROP(1); // name + f_number(); // n isnum + if (TOP().i) { + DROP(1); + f_interpretnumber(); + } else { + DROP(1); + f_interpretunknown(); + } + } else { // codepointer flags + f_interpretword(); + } +} + +void f_interpreter() { + while(1) { + f_word(); // w + if (TOP().s[0] == '\0') { + PUSHS("ok\n"); + f_puts(); + DROP(1); + return; + } + f_compileword(); + } +} + +void f_close() { + if (ACTIVE_FILE) { + fclose(ACTIVE_FILE); + ACTIVE_FILE = NULL; + } +} + +void f_open() { + FILE *fp; + fp = fopen(TOP().s, "ab+"); + fseek(fp, 0, SEEK_SET); + ACTIVE_FILE = fp; + DROP(1); +} + +void f_overwrite() { + f_close(); + ACTIVE_FILE = fopen(TOP().s, "wb+"); + DROP(1); +} + +void f_deactivate() { + PUSHP(ACTIVE_FILE); + ACTIVE_FILE = NULL; +} + +void f_activate() { + f_close(); + ACTIVE_FILE = TOP().fp; + DROP(1); +} + +void f_seek() { + fseek(ACTIVE_FILE, TOP().u, SEEK_SET); + DROP(1); +} + +void f_seekend() { + fseek(ACTIVE_FILE, 0, SEEK_END); +} + +void f_tell() { + PUSHU(ftell(ACTIVE_FILE)); +} + +void f_exists() { + struct stat statbuf; + int rc = stat(TOP().s, &statbuf); + TOP().i = rc == 0; +} + +struct ffblk findfile; +void f_findfirst() { + int result = findfirst(TOP().s, &findfile, 0); + if (result == 0) { + TOP().s = findfile.ff_name; + } else { + TOP().u = 0; + } +} + +void f_findnext() { + int result = findnext(&findfile); + if (result == 0) { + PUSHS(findfile.ff_name); + } else { + PUSHU(0); + } +} + +void f_chdir() { + chdir(TOP().s); + DROP(1); +} + +void f_doconst() { + PUSHC(*(W.p + 1)); +} + +void f_const() { + f_word(); + f_create(); + PUSHP(f_doconst); + f_comma(); + f_comma(); +} + +void f_dovar() { + PUSHCP(W.p + 1); +} + +void f_var() { + f_word(); + f_create(); + PUSHP(f_dovar); + f_comma(); + PUSHI(0); + f_comma(); +} + +void f_docreate() { + PUSHCP(W.p + 2); + RPUSH(IP); + IP = *(W.p + 1); +} + +void f_bz_() { + if (!TOP().u) { + IP.p = IP.p->p; // branch + } else { + IP.p ++; // skip branch destination cell + } + DROP(1); +} + +void f_bnz_() { + if (TOP().u) { + IP.p = IP.p->p; // branch + } else { + IP.p ++; // skip branch destination cell + } + DROP(1); +} + +void f_goto_() { + IP.p = IP.p->p; +} + +void f_inline_data_() { + PUSHCP(IP.p + 1); + IP = *IP.p; +} + +void f_memmove() { // ( dst src size -- ) + memmove(ST2().p, ST1().p, TOP().u); + DROP(3); +} + +void f_quote() { + if (STATE.i) { + PUSHS("LIT_"); + f_compileword(); + } else { + f_word(); + f_lookup(); + DROP(1); + } +} + +void f_rand() { + PUSHI(rand()); +} + +void f_init() { + CDEF("[", f_compileoff); f_immediate(); + CDEF("]", f_compileon); + CDEF("key", f_key); + CDEF("emit", f_emit); + CDEF("word", f_word); + CDEF("immediate", f_immediate); + CDEF("execute", f_execute); + CDEF("new-word", f_create); + CDEF("here", f_here); + CDEF("here!", f_here_set); + CDEF("there", f_there); + CDEF("latest", f_latest); + CDEF("latest!", f_latest_set); + CDEF("state", f_state); + CDEF("'", f_quote); f_immediate(); + CDEF("`", f_revlookup); + CDEF("wordname", f_wordname); + CDEF("wordflags", f_wordflags); + CDEF("codepointer", f_codepointer); + CDEF("lookup", f_lookup); + CDEF(":", f_colon); + CDEF(";", f_semicolon); f_immediate(); + CDEF("const", f_const); + CDEF("var", f_var); + CDEF("allot", f_allot); + CDEF("+", f_add); + CDEF("-", f_sub); + CDEF("*", f_mul); + CDEF("/", f_div); + CDEF("%", f_mod); + CDEF("=0", f_eq0); + CDEF("not", f_not); + CDEF("=", f_eq); + CDEF("!=", f_neq); + CDEF(">=", f_ge); + CDEF(">", f_gt); + CDEF("=", f_eq); + CDEF("<", f_lt); + CDEF("<=", f_le); + CDEF("u>=", f_uge); + CDEF("u>", f_ugt); + CDEF("u<", f_ult); + CDEF("u<=", f_ule); + CDEF("and", f_and); + CDEF("or", f_or); + CDEF("&", f_bitand); + CDEF("|", f_bitor); + CDEF("^", f_bitxor); + CDEF("<<", f_shl); + CDEF(">>", f_shr); + CDEF("/>ratio", f_toratio); + CDEF("*r", f_rput); + CDEF(" + +#define MEM_SIZE 40960 +#define STACK_SIZE 64 +#define RSTACK_SIZE 64 + +void f_init(); + +void f_cdef(); +void f_immediate(); + +void f_quiet(); +void f_loud(); +void f_interpreter(); + +union cell_union; +typedef union cell_union cell; + +union cell_union { + int i; + unsigned int u; + cell *p; + char *s; + void (*f)(); + FILE *fp; +}; + +extern char mem[MEM_SIZE]; +extern cell *HERE; +extern cell *LATEST; +extern cell IP; +extern cell W; +extern cell *rstack; +extern cell *stack; +extern FILE *IN_FILE; +extern FILE *OUT_FILE; +#define F_NAMELEN_MASK 0x7f +#define F_IMMEDIATE 0x80 + +#define CELL_OFFSET(cp, b) ((cell*)(((char *)(cp)) + b)) +#define TOP() (*(stack - 1)) +#define ST1() (*(stack - 2)) +#define ST2() (*(stack - 3)) +void DROP(int n); +void PUSHC(cell c); +void PUSHI(int i); +void PUSHU(unsigned int u); +void PUSHCP(cell *c); +#define PUSHP(p) PUSHCP((cell*)p) +void PUSHS(char *s); +void RPUSH(cell c); +#define RPOP() (--rstack) +#define RTOP() (*(rstack - 1)) + +void f_key(); +void f_word(); +void f_emit(); +void f_puts(); +void f_dot(); +void f_cr(); +void f_comma(); +void f_bcomma(); +void f_create(); // name -- +void f_cdef(); // func name -- +void f_doconst(); +void f_compileword(); + +cell f_lookupcp(char *name); +void f_execcp(cell cp); + +#define CDEF(name, def) PUSHP(def); PUSHS(name); f_cdef() +#define ICONST(name, v) CDEF(name, f_doconst); PUSHI(v); f_comma() +#define PCONST(name, p) CDEF(name, f_doconst); PUSHP(p); f_comma() diff --git a/minijort.prj b/minijort.prj new file mode 100755 index 0000000..b52d00d Binary files /dev/null and b/minijort.prj differ