/* RETRO ------------------------------------------------------ A personal, minimalistic forth Copyright (c) 2016 - 2020 Charles Childers This is the `repl`, a basic interactive interface for RETRO. It is intended to be simple and very minimalistic, providing the minimal I/O and additions needed to support a basic RETRO system. For a much larger system, see `rre`. I'll include commentary throughout the source, so read on. ---------------------------------------------------------- */ /*--------------------------------------------------------------------- Begin by including the various C headers needed. ---------------------------------------------------------------------*/ #include #include #include #include #include #include /*--------------------------------------------------------------------- First, a few constants relating to the image format and memory layout. If you modify the kernel (Rx.md), these will need to be altered to match your memory layout. ---------------------------------------------------------------------*/ #define TIB 1025 #define D_OFFSET_LINK 0 #define D_OFFSET_XT 1 #define D_OFFSET_CLASS 2 #define D_OFFSET_NAME 3 /*--------------------------------------------------------------------- Next we get into some things that relate to the Nga virtual machine that RETRO runs on. ---------------------------------------------------------------------*/ #ifndef BIT64 #define CELL int32_t #define CELL_MIN INT_MIN + 1 #define CELL_MAX INT_MAX - 1 #else #define CELL int64_t #define CELL_MIN LLONG_MIN + 1 #define CELL_MAX LLONG_MAX - 1 #endif #define IMAGE_SIZE 242000 /* Amount of RAM. 968kB by default. */ #define ADDRESSES 256 /* Depth of address stack */ #define STACK_DEPTH 128 /* Depth of data stack */ CELL sp, rp, ip; /* Data, address, instruction pointers */ CELL data[STACK_DEPTH]; /* The data stack */ CELL address[ADDRESSES]; /* The address stack */ CELL memory[IMAGE_SIZE + 1]; /* The memory for the image */ #define TOS data[sp] /* Shortcut for top item on stack */ #define NOS data[sp-1] /* Shortcut for second item on stack */ #define TORS address[rp] /* Shortcut for top item on address stack */ typedef void (*Handler)(void); /*--------------------------------------------------------------------- Embed a copy of the image into the executable. ---------------------------------------------------------------------*/ #include "image.c" /*--------------------------------------------------------------------- Moving forward, a few variables. These are updated to point to the latest values in the image. ---------------------------------------------------------------------*/ CELL Dictionary; CELL NotFound; CELL interpret; /*--------------------------------------------------------------------- Function prototypes. ---------------------------------------------------------------------*/ CELL stack_pop(); void stack_push(CELL value); CELL string_inject(char *str, CELL buffer); char *string_extract(CELL at); CELL d_link(CELL dt); CELL d_xt(CELL dt); CELL d_class(CELL dt); CELL d_name(CELL dt); CELL d_lookup(CELL Dictionary, char *name); CELL d_xt_for(char *Name, CELL Dictionary); void update_rx(); void execute(CELL cell); void evaluate(char *s); int not_eol(int ch); void read_token(FILE *file, char *token_buffer, int echo); CELL load_image(char *imageFile); void prepare_vm(); void process_opcode(); void process_opcode_bundle(CELL opcode); int validate_opcode_bundle(CELL opcode); /*--------------------------------------------------------------------- Here's an output helper. I define a wrapper over `write` to avoid using `printf()`. ---------------------------------------------------------------------*/ void retro_puts(char *s) { write(1, s, strlen(s)); } /*--------------------------------------------------------------------- Now to the fun stuff: interfacing with the virtual machine. There are a things I like to have here: - push a value to the stack - pop a value off the stack - extract a string from the image - inject a string into the image. - lookup dictionary headers and access dictionary fields ---------------------------------------------------------------------*/ /*--------------------------------------------------------------------- Stack push/pop is easy. I could avoid these, but it aids in keeping the code readable, so it's worth the slight overhead. ---------------------------------------------------------------------*/ CELL stack_pop() { sp--; return data[sp + 1]; } void stack_push(CELL value) { sp++; data[sp] = value; } /*--------------------------------------------------------------------- Strings are next. RETRO uses C-style NULL terminated strings. So I can easily inject or extract a string. Injection iterates over the string, copying it into the image. This also takes care to ensure that the NULL terminator is added. ---------------------------------------------------------------------*/ CELL string_inject(char *str, CELL buffer) { CELL i = 0; while (*str) { memory[buffer + i] = (CELL)*str++; memory[buffer + i + 1] = 0; i++; } return buffer; } /*--------------------------------------------------------------------- Extracting a string is similar, but I have to iterate over the VM memory instead of a C string and copy the charaters into a buffer. This uses a static buffer (`string_data`) as I prefer to avoid using `malloc()`. ---------------------------------------------------------------------*/ char string_data[1025]; char *string_extract(CELL at) { CELL starting = at; CELL i = 0; while(memory[starting] && i < 1024) string_data[i++] = (char)memory[starting++]; string_data[i] = 0; return (char *)string_data; } /*--------------------------------------------------------------------- Continuing along, I now define functions to access the dictionary. RETRO's dictionary is a linked list. Each entry is setup like: 0000 Link to previous entry (NULL if this is the root entry) 0001 Pointer to definition start 0002 Pointer to class handler 0003 Start of a NULL terminated string with the word name First, functions to access each field. The offsets were defineed at the start of the file. ---------------------------------------------------------------------*/ CELL d_link(CELL dt) { return dt + D_OFFSET_LINK; } CELL d_xt(CELL dt) { return dt + D_OFFSET_XT; } CELL d_class(CELL dt) { return dt + D_OFFSET_CLASS; } CELL d_name(CELL dt) { return dt + D_OFFSET_NAME; } /*--------------------------------------------------------------------- Next, a more complext word. This will walk through the entries to find one with a name that matches the specified name. This is *slow*, but works ok unless you have a really large dictionary. (I've not run into issues with this in practice). ---------------------------------------------------------------------*/ CELL d_lookup(CELL Dictionary, char *name) { CELL dt = 0; CELL i = Dictionary; char *dname; while (memory[i] != 0 && i != 0) { dname = string_extract(d_name(i)); if (strcmp(dname, name) == 0) { dt = i; i = 0; } else { i = memory[i]; } } return dt; } /*--------------------------------------------------------------------- My last dictionary related word returns the `xt` pointer for a word. This is used to help keep various important bits up to date. ---------------------------------------------------------------------*/ CELL d_xt_for(char *Name, CELL Dictionary) { return memory[d_xt(d_lookup(Dictionary, Name))]; } /*--------------------------------------------------------------------- This interface tracks a few words and variables in the image. These are: Dictionary - the latest dictionary header NotFound - called when a word is not found interpret - the heart of the interpreter/compiler I have to call this periodically, as the Dictionary will change as new words are defined, and the user might write a new error handler or interpreter. ---------------------------------------------------------------------*/ void update_rx() { Dictionary = memory[2]; NotFound = d_xt_for("err:notfound", Dictionary); interpret = d_xt_for("interpret", Dictionary); } /*--------------------------------------------------------------------- With these out of the way, I implement `execute`, which takes an address and runs the code at it. This has a couple of interesting bits. Nga uses packed instruction bundles, with up to four instructions per bundle. Since RETRO requires an additional instruction to handle displaying a character, I define the handler for that here. This will also exit if the address stack depth is zero (meaning that the word being run, and it's dependencies) are finished. ---------------------------------------------------------------------*/ void generic_output() { } void generic_output_query() { stack_push(0); stack_push(0); } void execute(CELL cell) { CELL opcode; rp = 1; ip = cell; while (ip < IMAGE_SIZE) { if (ip == NotFound) { retro_puts("\nERROR: Word Not Found: "); retro_puts(string_extract(TIB)); retro_puts("\n\n"); } opcode = memory[ip]; if (validate_opcode_bundle(opcode) != 0) { process_opcode_bundle(opcode); } else { retro_puts("Invalid instruction!\n"); exit(1); } ip++; if (rp == 0) ip = IMAGE_SIZE; } } /*--------------------------------------------------------------------- RETRO's `interpret` word expects a token on the stack. This next function copies a token to the `TIB` (text input buffer) and then calls `interpret` to process it. ---------------------------------------------------------------------*/ void evaluate(char *s) { if (strlen(s) == 0) return; update_rx(); string_inject(s, TIB); stack_push(TIB); execute(interpret); } /*--------------------------------------------------------------------- `read_token` reads a token from the specified file. It will stop on a whitespace or newline. It also tries to handle backspaces, though the success of this depends on how your terminal is configured. ---------------------------------------------------------------------*/ int not_eol(int ch) { return (ch != (char)10) && (ch != (char)13) && (ch != (char)32) && (ch != EOF) && (ch != 0); } void read_token(FILE *file, char *token_buffer, int echo) { int ch, count; ch = getc(file); if (echo != 0) putchar(ch); count = 0; while (not_eol(ch)) { if ((ch == 8 || ch == 127) && count > 0) { count--; if (echo != 0) { putchar(8); putchar(32); putchar(8); } } else { token_buffer[count++] = ch; } ch = getc(file); if (echo != 0) putchar(ch); } token_buffer[count] = '\0'; } /*--------------------------------------------------------------------- The `main()` routine. This sets up the Nga VM, loads the image, and enters a loop. The loop: - reads input - if input == 'bye', exit - otherwise, pass to `evaluate()` to run ---------------------------------------------------------------------*/ int main(int argc, char **argv) { char input[1024]; prepare_vm(); load_image("ngaImage"); update_rx(); retro_puts("RETRO Listener (c) 2016-2020, Charles Childers\n\n"); while(1) { Dictionary = memory[2]; read_token(stdin, input, 0); if (strcmp(input, "bye") == 0) exit(0); else evaluate(input); } exit(0); } /* Nga ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Copyright (c) 2008 - 2020, Charles Childers Copyright (c) 2009 - 2010, Luke Parrish Copyright (c) 2010, Marc Simpson Copyright (c) 2010, Jay Skeer Copyright (c) 2011, Kenneth Keating ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */ #ifndef NUM_DEVICES #define NUM_DEVICES 0 #endif CELL load_image(char *imageFile) { FILE *fp; CELL imageSize; long fileLen; CELL i; if ((fp = fopen(imageFile, "rb")) != NULL) { /* Determine length (in cells) */ fseek(fp, 0, SEEK_END); fileLen = ftell(fp) / sizeof(CELL); rewind(fp); /* Read the file into memory */ imageSize = fread(&memory, sizeof(CELL), fileLen, fp); fclose(fp); } else { for (i = 0; i < ngaImageCells; i++) memory[i] = ngaImage[i]; imageSize = i; } return imageSize; } void prepare_vm() { ip = sp = rp = 0; for (ip = 0; ip < IMAGE_SIZE; ip++) memory[ip] = 0; /* NO - nop instruction */ for (ip = 0; ip < STACK_DEPTH; ip++) data[ip] = 0; for (ip = 0; ip < ADDRESSES; ip++) address[ip] = 0; } void inst_no() { } void inst_li() { sp++; ip++; TOS = memory[ip]; } void inst_du() { sp++; data[sp] = NOS; } void inst_dr() { data[sp] = 0; if (--sp < 0) ip = IMAGE_SIZE; } void inst_sw() { CELL a; a = TOS; TOS = NOS; NOS = a; } void inst_pu() { rp++; TORS = TOS; inst_dr(); } void inst_po() { sp++; TOS = TORS; rp--; } void inst_ju() { ip = TOS - 1; inst_dr(); } void inst_ca() { rp++; TORS = ip; ip = TOS - 1; inst_dr(); } void inst_cc() { CELL a, b; a = TOS; inst_dr(); /* Target */ b = TOS; inst_dr(); /* Flag */ if (b != 0) { rp++; TORS = ip; ip = a - 1; } } void inst_re() { ip = TORS; rp--; } void inst_eq() { NOS = (NOS == TOS) ? -1 : 0; inst_dr(); } void inst_ne() { NOS = (NOS != TOS) ? -1 : 0; inst_dr(); } void inst_lt() { NOS = (NOS < TOS) ? -1 : 0; inst_dr(); } void inst_gt() { NOS = (NOS > TOS) ? -1 : 0; inst_dr(); } void inst_fe() { switch (TOS) { case -1: TOS = sp - 1; break; case -2: TOS = rp; break; case -3: TOS = IMAGE_SIZE; break; case -4: TOS = CELL_MIN; break; case -5: TOS = CELL_MAX; break; default: TOS = memory[TOS]; break; } } void inst_st() { if (TOS <= IMAGE_SIZE && TOS >= 0) { memory[TOS] = NOS; inst_dr(); inst_dr(); } else { ip = IMAGE_SIZE; } } void inst_ad() { NOS += TOS; inst_dr(); } void inst_su() { NOS -= TOS; inst_dr(); } void inst_mu() { NOS *= TOS; inst_dr(); } void inst_di() { CELL a, b; a = TOS; b = NOS; TOS = b / a; NOS = b % a; } void inst_an() { NOS = TOS & NOS; inst_dr(); } void inst_or() { NOS = TOS | NOS; inst_dr(); } void inst_xo() { NOS = TOS ^ NOS; inst_dr(); } void inst_sh() { CELL y = TOS; CELL x = NOS; if (TOS < 0) NOS = NOS << (TOS * -1); else { if (x < 0 && y > 0) NOS = x >> y | ~(~0U >> y); else NOS = x >> y; } inst_dr(); } void inst_zr() { if (TOS == 0) { inst_dr(); ip = TORS; rp--; } } void inst_ha() { ip = IMAGE_SIZE; } void inst_ie() { stack_push(1); } void inst_iq() { inst_dr(); stack_push(0); stack_push(0); } void inst_ii() { inst_dr(); putc(stack_pop(), stdout); fflush(stdout); } Handler instructions[] = { inst_no, inst_li, inst_du, inst_dr, inst_sw, inst_pu, inst_po, inst_ju, inst_ca, inst_cc, inst_re, inst_eq, inst_ne, inst_lt, inst_gt, inst_fe, inst_st, inst_ad, inst_su, inst_mu, inst_di, inst_an, inst_or, inst_xo, inst_sh, inst_zr, inst_ha, inst_ie, inst_iq, inst_ii }; void process_opcode(CELL opcode) { if (opcode != 0) instructions[opcode](); } int validate_opcode_bundle(CELL opcode) { CELL raw = opcode; CELL current; int valid = -1; int i; for (i = 0; i < 4; i++) { current = raw & 0xFF; if (!(current >= 0 && current <= 29)) valid = 0; raw = raw >> 8; } return valid; } void process_opcode_bundle(CELL opcode) { CELL raw = opcode; int i; for (i = 0; i < 4; i++) { process_opcode(raw & 0xFF); raw = raw >> 8; } }