pete286/jorth.c

1247 lines
22 KiB
C
Raw Normal View History

//#define TRACE
#include <stdio.h>
#include <sys/stat.h>
#include <dos.h>
#include <dir.h>
#include "jorth.h"
#define TASK_REGISTER_SIZE 3
#define TASK_USER_SIZE 8
#define TASK_HEADER_SIZE (TASK_USER_SIZE + TASK_REGISTER_SIZE)
#define TASK_SIZE (TASK_HEADER_SIZE + STACK_SIZE + RSTACK_SIZE)
#define STACK_OFFSET (TASK_HEADER_SIZE)
#define RSTACK_OFFSET (TASK_HEADER_SIZE + STACK_SIZE)
#define TASK_USER_NEXT 0
#define TASK_USER_STATE 1
#define TASK_USER_MAILBOX 2
#define TASK_USER_QUIET 3
#define TASK_USER_KEY 4
#define TASK_USER_KEYSRC 5
#define TASK_USER_ECHO 6
#define TASK_USER_EMIT 7
char mem[MEM_SIZE] = { 0 };
cell *HERE = ((cell*)mem) + TASK_SIZE;
cell *LATEST = NULL;
cell IP = NULL;
cell W = NULL;
#define STATE (*(RUNNING + TASK_USER_STATE))
cell *RUNNING = (cell*)mem;
cell *TASKS = (cell*)mem;
cell *stack = ((cell*)mem) + STACK_OFFSET;
cell *rstack = ((cell*)mem) + RSTACK_OFFSET;
#ifdef TRACE
int TRACING = 0;
#endif
#define QUIET (*(RUNNING + TASK_USER_QUIET))
FILE *ACTIVE_FILE = NULL;
void DROP(n) {
stack -= n;
if (stack < RUNNING + STACK_OFFSET) {
stack = RUNNING + 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++; }
2019-02-02 00:05:02 +00:00
void f_here() {
PUSHCP(HERE);
}
void f_here_set() {
HERE = TOP().p;
DROP(1);
}
2019-02-02 00:05:02 +00:00
void f_latest() {
PUSHCP(LATEST);
}
void f_latest_set() {
LATEST = TOP().p;
DROP(1);
}
void f_tasks() {
PUSHCP(TASKS);
}
void f_tasks_set() {
TASKS = TOP().p;
DROP(1);
}
2019-02-02 00:05:02 +00:00
void f_state() {
PUSHC(STATE);
}
void f_running() {
PUSHCP(RUNNING);
}
#define BINOP(name, type, op) \
void name() { \
cell r = TOP(); \
DROP(1); \
TOP().type = TOP().type op r.type; \
}
2019-02-02 00:05:02 +00:00
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, <<)
2019-02-18 01:14:56 +00:00
#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);
}
2019-02-18 01:14:56 +00:00
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();
2019-02-02 00:05:02 +00:00
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);
}
2019-02-11 00:17:58 +00:00
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() {
2019-02-02 00:05:02 +00:00
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_key_string() {
cell *INPUT = RUNNING + TASK_USER_KEYSRC;
if (INPUT->p) {
PUSHCP(INPUT->p);
f_bget();
if (TOP().i != 0) {
INPUT->p = CELL_OFFSET(INPUT->p, 1);
} else {
INPUT->p = NULL;
}
} else {
PUSHI(0);
}
}
void f_key_file() {
cell *INPUT = RUNNING + TASK_USER_KEYSRC;
int val = 0;
if (INPUT->fp) {
val = fgetc(INPUT->fp);
if (val == EOF) {
fclose(INPUT->fp);
INPUT->fp = NULL;
val = 0;
}
}
PUSHI(val);
}
void f_key() {
cell *keyword = RUNNING + TASK_USER_KEY;
cell *echoword = RUNNING + TASK_USER_ECHO;
if (keyword->p) {
PUSHCP(keyword->p);
f_cexecute();
} else {
PUSHI(0);
}
if (!QUIET.i && echoword->p) {
f_dup();
PUSHCP(echoword->p);
f_cexecute();
}
}
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) {
buf[ibuf++] = key;
f_key();
key = TOP().i;
DROP(1);
}
buf[ibuf] = 0;
PUSHS(buf);
}
void f_emit() {
if (!QUIET.i) {
cell *echoword = RUNNING + TASK_USER_ECHO;
cell *emitword = RUNNING + TASK_USER_EMIT;
if (echoword->p) {
f_dup();
PUSHCP(echoword->p);
f_cexecute();
}
if (emitword->p) {
PUSHCP(emitword->p);
f_cexecute();
} else {
DROP(1);
}
} else {
DROP(1);
}
}
void f_putc() {
printf("%c", TOP().i);
DROP(1);
}
void f_fputc() {
if (ACTIVE_FILE) {
2019-02-24 22:26:28 +00:00
fwrite(&TOP().i, 1, 1, ACTIVE_FILE);
}
DROP(1);
}
void f_gets() {
gets(TOP().s);
}
void f_fput() {
if (ACTIVE_FILE) {
2019-02-24 22:26:28 +00:00
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() {
2019-02-24 22:26:28 +00:00
int result = EOF;
if (ACTIVE_FILE) {
result = fgetc(ACTIVE_FILE);
}
2019-02-24 22:26:28 +00:00
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);
}
}
2019-02-02 00:05:02 +00:00
void f_puts() {
char *s = TOP().s;
while (s && *s) {
PUSHI(*s);
f_emit();
s++;
}
DROP(1);
}
2019-02-02 00:05:02 +00:00
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 = RUNNING + STACK_OFFSET;
while (v != stack) {
PUSHC(*v++);
f_dot();
}
}
2019-02-02 00:05:02 +00:00
void f_printrstack() {
cell *v = RUNNING + RSTACK_OFFSET;
while (v != rstack) {
PUSHC(*v++);
f_dot();
}
}
void f_cr() {
PUSHI('\n');
f_emit();
}
void f_comma() {
*HERE++ = TOP();
DROP(1);
}
2019-02-11 00:17:58 +00:00
void f_allot() {
2019-05-18 19:30:58 +00:00
memset(HERE, 0, TOP().u);
2019-02-11 00:17:58 +00:00
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().u = TOP().p[1].u;
}
void f_codepointer() {
unsigned int flags = TOP().p[1].u;
TOP().p = CELL_OFFSET(TOP().p + 2, (flags & ~F_IMMEDIATE) + 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();
if (len == (TOP().u & ~F_IMMEDIATE)) {
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);
}
2019-02-02 00:05:02 +00:00
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();
2019-02-02 00:05:02 +00:00
return;
}
DROP(1);
2019-02-02 00:05:02 +00:00
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;
}
2019-02-02 00:05:02 +00:00
void f_compileword();
void f_semicolon() {
PUSHS("ret");
2019-02-02 00:05:02 +00:00
f_compileword();
f_compileoff();
}
void f_ret() {
if (rstack == RUNNING + 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_");
2019-02-02 00:05:02 +00:00
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;
2019-02-24 22:26:28 +00:00
fp = fopen(TOP().s, "ab+");
fseek(fp, 0, SEEK_SET);
ACTIVE_FILE = fp;
DROP(1);
2019-02-02 00:05:02 +00:00
}
void f_overwrite() {
f_close();
2019-02-24 22:26:28 +00:00
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_swapinput() {
cell *key = RUNNING + TASK_USER_KEY;
cell *keysrc = RUNNING + TASK_USER_KEYSRC;
cell oldKey = *key;
cell oldKeysrc = *keysrc;
*key = TOP();
*keysrc = ST1();
TOP() = oldKey;
ST1() = oldKeysrc;
}
void f_taskemit() {
PUSHCP(RUNNING + TASK_USER_EMIT);
}
void f_taskecho() {
PUSHCP(RUNNING + TASK_USER_ECHO);
}
void f_doconst() {
PUSHC(*(W.p + 1));
}
void f_const() {
f_word();
f_create();
PUSHP(f_doconst);
f_comma();
2019-02-02 00:05:02 +00:00
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);
2019-02-02 00:05:02 +00:00
}
2019-02-02 00:05:02 +00:00
void f_goto_() {
IP.p = IP.p->p;
}
void f_inline_data_() {
PUSHCP(IP.p + 1);
IP = *IP.p;
}
2019-02-24 22:26:28 +00:00
void f_memmove() { // ( dst src size -- )
memmove(ST2().p, ST1().p, TOP().u);
DROP(3);
}
2019-02-02 00:05:02 +00:00
void f_quote() {
if (STATE.i) {
PUSHS("LIT_");
2019-02-02 00:05:02 +00:00
f_compileword();
} else {
f_word();
f_lookup();
DROP(1);
}
}
void f_imagefilename() {
static char imagefilename[32];
int i;
strcpy(imagefilename, TOP().s);
for (i = 0; i < strlen(imagefilename); i ++) {
if (imagefilename[i] == '.') break;
}
strcpy(&imagefilename[i], ".jim");
TOP().s = imagefilename;
}
void f_image_up_to_date() {
struct stat src, img;
int uptodate = 0;
f_dup();
f_imagefilename();
if (stat(TOP().s, &img) == 0 && stat(ST1().s, &src) == 0) {
uptodate = img.st_mtime > src.st_mtime;
}
DROP(1);
TOP().i = uptodate;
}
static int imagemagic = -1;
static void f_calc_imagemagic(char *exefilename) {
struct stat exe;
if (stat(exefilename, &exe) == 0) {
imagemagic = exe.st_mtime;
}
}
void f_loadimage() {
cell *start, *latestNew, *tasksNew;
size_t size;
int magic;
fread(&magic, sizeof(int), 1, ACTIVE_FILE);
if (magic != imagemagic) {
PUSHI(0);
return;
}
fread(&start, sizeof(cell *), 1, ACTIVE_FILE);
fread(&latestNew, sizeof(cell *), 1, ACTIVE_FILE);
fread(&tasksNew, sizeof(cell *), 1, ACTIVE_FILE);
fread(&size, sizeof(size_t), 1, ACTIVE_FILE);
if (start != HERE) {
fseek(ACTIVE_FILE, size, SEEK_CUR);
PUSHI(0);
} else {
fread(HERE, 1, size, ACTIVE_FILE);
HERE = CELL_OFFSET(HERE, size);
LATEST = latestNew;
TASKS = tasksNew;
PUSHI(1);
}
}
void f_saveimage() {
size_t size = (size_t)(((char*)HERE) - TOP().s);
fwrite(&imagemagic, sizeof(int), 1, ACTIVE_FILE);
fwrite(&TOP().p, sizeof(cell *), 1, ACTIVE_FILE);
fwrite(&LATEST, sizeof(cell *), 1, ACTIVE_FILE);
fwrite(&TASKS, sizeof(cell *), 1, ACTIVE_FILE);
fwrite(&size, sizeof(size_t), 1, ACTIVE_FILE);
fwrite(TOP().p, 1, size, ACTIVE_FILE);
DROP(1);
}
2019-02-02 00:05:02 +00:00
void f_loadfile(char *filename) {
PUSHS(filename);
PUSHS("loadfile");
f_lookup();
DROP(1);
f_cexecute();
}
void f_loadjor(char *filename) {
PUSHS(filename);
PUSHS("loadjor");
f_lookup();
DROP(1);
f_cexecute();
}
// does not use the jorth interpreter defined in boot.jor
void f_loadfile_cterp(char *filename) {
cell *start = HERE;
PUSHS(filename);
f_dup();
f_image_up_to_date();
if (TOP().i) {
DROP(1);
f_dup();
f_imagefilename();
f_open();
f_loadimage();
f_close();
if (TOP().i) {
DROP(2);
return;
}
}
DROP(1);
f_open();
f_deactivate();
PUSHS("key-file");
f_lookup();
DROP(1);
f_swapinput();
f_interpreter();
f_swapinput();
DROP(2);
PUSHS(filename);
f_imagefilename();
f_overwrite();
PUSHCP(start);
f_saveimage();
f_close();
}
void f_runstring(char *s) {
PUSHS(s);
PUSHS("loadstring");
f_lookup();
DROP(1);
f_cexecute();
}
void f_quiet() {
QUIET.i = 1;
}
void f_loud() {
QUIET.i = 0;
}
// task switching
void f_task() {
cell *task = HERE;
HERE += TASK_SIZE;
memset(task, 0, TASK_SIZE * 2);
task->p = TASKS;
TASKS = task;
PUSHP(task);
}
void f_suspend() {
cell *registers = RUNNING + TASK_USER_SIZE;
registers[0] = IP;
registers[1].p = stack;
registers[2].p = rstack;
IP.p = 0;
}
void f_restore() {
cell *registers = RUNNING + TASK_USER_SIZE;
IP = registers[0];
stack = registers[1].p;
rstack = registers[2].p;
}
// run all tasks once, except the task that triggered the loop
void f_taskloop() {
cell *task = RUNNING;
f_suspend();
RUNNING = TASKS;
while (RUNNING) {
if (RUNNING != task) {
f_restore();
f_colonloop();
}
RUNNING = RUNNING->p;
}
RUNNING = task;
f_restore();
}
void f_stacksize() {
PUSHU(STACK_SIZE);
}
void f_rstacksize() {
PUSHU(RSTACK_SIZE);
}
void f_taskusersize() {
PUSHU(TASK_USER_SIZE);
}
void f_init(char *exe) {
f_calc_imagemagic(exe);
CDEF("[", f_compileoff); f_immediate();
CDEF("]", f_compileon);
2019-02-02 00:05:02 +00:00
CDEF("key", f_key);
CDEF("key-string", f_key_string);
CDEF("key-file", f_key_file);
2019-02-02 00:05:02 +00:00
CDEF("emit", f_emit);
CDEF("word", f_word);
CDEF("immediate", f_immediate);
CDEF("execute", f_execute);
2019-02-11 00:17:58 +00:00
CDEF("new-word", f_create);
2019-02-02 00:05:02 +00:00
CDEF("here", f_here);
CDEF("here!", f_here_set);
2019-02-02 00:05:02 +00:00
CDEF("latest", f_latest);
CDEF("latest!", f_latest_set);
CDEF("tasks", f_tasks);
CDEF("tasks!", f_tasks_set);
2019-02-02 00:05:02 +00:00
CDEF("state", f_state);
CDEF("'", f_quote); f_immediate();
CDEF("`", f_revlookup);
2019-02-11 00:17:58 +00:00
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);
2019-02-11 00:17:58 +00:00
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);
2019-02-18 01:14:56 +00:00
CDEF("/>ratio", f_toratio);
CDEF("*<ratio", f_fromratio);
CDEF("@", f_get);
CDEF("!", f_set);
2019-02-11 00:17:58 +00:00
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);
2019-02-02 00:05:02 +00:00
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("task-emit", f_taskemit);
CDEF("task-echo", f_taskecho);
CDEF("swap-input", f_swapinput);
CDEF("putc", f_putc);
CDEF("fputc", f_fputc);
CDEF("gets", f_gets);
CDEF("number", f_number);
CDEF("LIT_", f_lit_);
2019-02-02 00:05:02 +00:00
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);
2019-02-24 22:26:28 +00:00
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("imagefilename", f_imagefilename);
CDEF("image-uptodate", f_image_up_to_date);
CDEF("loadimage", f_loadimage);
CDEF("saveimage", f_saveimage);
2019-02-24 22:26:28 +00:00
CDEF("memmove", f_memmove);
CDEF("quiet", f_quiet);
CDEF("loud", f_loud);
CDEF("task", f_task);
CDEF("suspend", f_suspend);
CDEF("taskloop", f_taskloop);
CDEF("running", f_running);
CDEF("stacksize", f_stacksize);
CDEF("rstacksize", f_rstacksize);
CDEF("task-user-size", f_taskusersize);
PCONST("$DOCREATE", f_docreate);
PCONST("$DOVAR", f_dovar);
PCONST("$DODEFERRED", f_dodeferred);
ICONST("imagemagic", imagemagic);
#ifdef TRACE
CDEF("traceon", f_traceon);
CDEF("traceoff", f_traceoff);
#endif
f_loadfile_cterp("boot.jor");
f_loadfile("defs.jor");
}
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;
}
void f_repl() {
char input[256];
CDEF("quit", f_quit);
f_runstring("stdout");
while (!DIE) {
f_runstring(gets(input));
}
}