First cut at stripping down minijort
This commit is contained in:
commit
791e4644aa
4
.gitignore
vendored
Normal file
4
.gitignore
vendored
Normal file
|
@ -0,0 +1,4 @@
|
|||
*.bak
|
||||
*.obj
|
||||
*.dsk
|
||||
|
66
boot.jor
Executable file
66
boot.jor
Executable file
|
@ -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 infile ! ;
|
||||
: loadfile ( filename -- ) fdeactivate >r open loadfp close <r factivate ;
|
||||
|
||||
( image loading )
|
||||
: noop ;
|
||||
|
||||
: defer word new-word $DODEFERRED , ' noop , ;
|
||||
: redefine ( cp cpdeferred ) cell + ! ;
|
||||
: definition ( cpdeferred ) cell + @ ;
|
||||
|
11
main.c
Executable file
11
main.c
Executable file
|
@ -0,0 +1,11 @@
|
|||
#include "minijort.h"
|
||||
|
||||
int main(int argc, char *argv[]) {
|
||||
f_init();
|
||||
IN_FILE = fopen("boot.jor", "rt");
|
||||
f_interpreter();
|
||||
fclose(IN_FILE);
|
||||
IN_FILE = stdin;
|
||||
f_execcp( f_lookupcp("interpreter"));
|
||||
return 0;
|
||||
}
|
936
minijort.c
Executable file
936
minijort.c
Executable file
|
@ -0,0 +1,936 @@
|
|||
//#define TRACE
|
||||
|
||||
#include <stdio.h>
|
||||
#include <stdlib.h>
|
||||
#include <sys/stat.h>
|
||||
#include <dos.h>
|
||||
#include <dir.h>
|
||||
#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("*<ratio", f_fromratio);
|
||||
CDEF("@", f_get);
|
||||
CDEF("!", f_set);
|
||||
CDEF("+!", f_addset);
|
||||
CDEF("b@", f_bget);
|
||||
CDEF("ub@", f_ubget);
|
||||
CDEF("b!", f_bset);
|
||||
CDEF("!far", f_farset);
|
||||
CDEF("@far", f_farget);
|
||||
CDEF("b!far", f_farbset);
|
||||
CDEF("b@far", f_farbget);
|
||||
CDEF("dup", f_dup);
|
||||
CDEF("over", f_over);
|
||||
CDEF("drop", f_drop);
|
||||
CDEF("swap", f_swap);
|
||||
CDEF("<rot", f_rot);
|
||||
CDEF(">r", f_rput);
|
||||
CDEF("<r", f_rtake);
|
||||
CDEF("r@", f_rtop);
|
||||
CDEF("rdrop", f_rdrop);
|
||||
CDEF("rswap", f_rswap);
|
||||
CDEF("fputc", f_fputc);
|
||||
CDEF("gets", f_gets);
|
||||
CDEF("number", f_number);
|
||||
CDEF("LIT_", f_lit_);
|
||||
CDEF("GOTO_", f_goto_);
|
||||
CDEF("BZ_", f_bz_);
|
||||
CDEF("BNZ_", f_bnz_);
|
||||
CDEF("INLINEDATA_", f_inline_data_);
|
||||
CDEF("ret", f_ret);
|
||||
CDEF(".", f_dot);
|
||||
CDEF("u.", f_udot);
|
||||
CDEF("type", f_puts);
|
||||
CDEF(".s", f_printstack);
|
||||
CDEF(".rs", f_printrstack);
|
||||
CDEF(",", f_comma);
|
||||
CDEF("b,", f_bcomma);
|
||||
CDEF("open", f_open);
|
||||
CDEF("overwrite", f_overwrite);
|
||||
CDEF("close", f_close);
|
||||
CDEF("exists", f_exists);
|
||||
CDEF("factivate", f_activate);
|
||||
CDEF("fdeactivate", f_deactivate);
|
||||
CDEF("seek", f_seek);
|
||||
CDEF("seekend", f_seekend);
|
||||
CDEF("tell", f_tell);
|
||||
CDEF("fputc", f_fputc);
|
||||
CDEF("fput", f_fput);
|
||||
CDEF("fgetc", f_fgetc);
|
||||
CDEF("fget", f_fget);
|
||||
CDEF("fwrite", f_fwrite);
|
||||
CDEF("fread", f_fread);
|
||||
CDEF("findfile", f_findfirst);
|
||||
CDEF("nextfile", f_findnext);
|
||||
CDEF("chdir", f_chdir);
|
||||
CDEF("memmove", f_memmove);
|
||||
CDEF("rand", f_rand);
|
||||
PCONST("$DOCREATE", f_docreate);
|
||||
PCONST("$DOVAR", f_dovar);
|
||||
PCONST("$DODEFERRED", f_dodeferred);
|
||||
PCONST("infile", &IN_FILE);
|
||||
PCONST("outfile", &OUT_FILE);
|
||||
PCONST("stdin", stdin);
|
||||
PCONST("stdout", stdout);
|
||||
#ifdef TRACE
|
||||
CDEF("traceon", f_traceon);
|
||||
CDEF("traceoff", f_traceoff);
|
||||
#endif
|
||||
}
|
||||
|
||||
cell f_lookupcp(char *name) {
|
||||
cell result = {0};
|
||||
PUSHS(name);
|
||||
f_lookup();
|
||||
if (TOP().u) {
|
||||
result = ST1();
|
||||
}
|
||||
DROP(2);
|
||||
return result;
|
||||
}
|
||||
|
||||
void f_execcp(cell cp) {
|
||||
PUSHC(cp);
|
||||
f_cexecute();
|
||||
}
|
||||
|
||||
int DIE = 0;
|
||||
void f_quit() {
|
||||
DIE = 1;
|
||||
}
|
||||
|
BIN
minijort.exe
Executable file
BIN
minijort.exe
Executable file
Binary file not shown.
73
minijort.h
Executable file
73
minijort.h
Executable file
|
@ -0,0 +1,73 @@
|
|||
#include <stdio.h>
|
||||
|
||||
#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()
|
BIN
minijort.prj
Executable file
BIN
minijort.prj
Executable file
Binary file not shown.
Loading…
Reference in a new issue