665 lines
16 KiB
C
665 lines
16 KiB
C
/* 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 <stdio.h>
|
|
#include <stdlib.h>
|
|
#include <unistd.h>
|
|
#include <string.h>
|
|
#include <stdint.h>
|
|
#include <limits.h>
|
|
|
|
/*---------------------------------------------------------------------
|
|
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;
|
|
}
|
|
}
|