diff --git a/Makefile b/Makefile index 7b6b834..32a95c0 100644 --- a/Makefile +++ b/Makefile @@ -161,7 +161,7 @@ interfaces/image.c: bin/retro-embedimage bin/retro-extend bin/retro-muri literat bin/retro-compiler: io bin/retro-extend interfaces/image.c interfaces/retro-compiler.c interfaces/retro-compiler-runtime.c interfaces/image-functions.o cp ngaImage runtime.image ./bin/retro-extend runtime.image interfaces/io/filesystem.forth interfaces/io/gopher.forth interfaces/io/floatingpoint.forth interfaces/io/unix.forth interfaces/io/rng.forth interfaces/rre.forth - cd interfaces && $(CC) $(CFLAGS) $(LDFLAGS) -o ../retro-compiler-runtime retro-compiler-runtime.c image-functions.c $(RREIO) $(LIBM) + cd interfaces && $(CC) $(CFLAGS) $(LDFLAGS) -o ../retro-compiler-runtime retro-compiler-runtime.c $(LIBM) cd interfaces && $(CC) $(CFLAGS) $(LDFLAGS) -o ../bin/retro-compiler retro-compiler.c objcopy --add-section .ngaImage=runtime.image --set-section-flags .ngaImage=noload,readonly bin/retro-compiler objcopy --add-section .runtime=retro-compiler-runtime --set-section-flags .runtime=noload,readonly bin/retro-compiler diff --git a/interfaces/retro-compiler-runtime.c b/interfaces/retro-compiler-runtime.c index 46a8a7e..7352fc4 100644 --- a/interfaces/retro-compiler-runtime.c +++ b/interfaces/retro-compiler-runtime.c @@ -1,22 +1,95 @@ -/* RETRO ------------------------------------------------------------- - A personal, minimalistic forth - Copyright (c) 2016 - 2019 Charles Childers +/*--------------------------------------------------------------------- + RETRO is a personal, minimalistic forth with a pragmatic focus + + This implements Nga, the virtual machine at the heart of RETRO. It + includes a number of I/O interfaces, extensive commentary, and has + been refined by over a decade of use and development. + + Copyright (c) 2008 - 2019, Charles Childers + + Portions are based on Ngaro, which was additionally copyrighted by + the following: + + Copyright (c) 2009 - 2010, Luke Parrish + Copyright (c) 2010, Marc Simpson + Copyright (c) 2010, Jay Skeer + Copyright (c) 2011, Kenneth Keating ---------------------------------------------------------------------*/ + +/*--------------------------------------------------------------------- + C Headers + ---------------------------------------------------------------------*/ + +#include +#include +#include +#include +#include #include -#include #include #include +#include +#include +#include +#include +#include +#include -#include "image-functions.h" -CELL sp, rp, ip; /* Data, address, instruction pointers */ +/*--------------------------------------------------------------------- + Configuration + ---------------------------------------------------------------------*/ + +#define CELL int32_t /* Cell size (32 bit, signed integer */ +#define IMAGE_SIZE 524288 * 2 /* Amount of RAM. 12MiB by default. */ +#define ADDRESSES 256 /* Depth of address stack */ +#define STACK_DEPTH 256 /* Depth of data stack */ + +#define TIB 1025 /* Location of TIB */ + +#define D_OFFSET_LINK 0 /* Dictionary Format Info. Update if */ +#define D_OFFSET_XT 1 /* you change the dictionary fields. */ +#define D_OFFSET_CLASS 2 +#define D_OFFSET_NAME 3 + +#define NUM_DEVICES 8 /* Set the number of I/O devices */ + +#define MAX_OPEN_FILES 128 +#define GOPHER_MAX_FILE_SIZE (128 * 1024) + 1 + + +/*--------------------------------------------------------------------- + Image, Stack, and VM variables + ---------------------------------------------------------------------*/ + +CELL sp, rp, ip; /* Stack & 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 */ -void generic_output(); -void generic_output_query(); +#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 */ + + +/*--------------------------------------------------------------------- + Function Prototypes + ---------------------------------------------------------------------*/ + +CELL stack_pop(); +void stack_push(CELL value); +CELL string_inject(char *str, CELL buffer); +char *string_extract(CELL at); +CELL d_xt_for(char *Name, CELL Dictionary); +void update_rx(); +void ngaProcessPackedOpcodes(CELL opcode); +int ngaValidatePackedOpcodes(CELL opcode); +void include_file(char *fname, int run_tests); +CELL ngaLoadImage(char *imageFile); +void ngaPrepare(); +void io_output_handler(); +void io_output_query(); void io_keyboard_handler(); void io_keyboard_query(); void io_filesystem_query(); @@ -32,45 +105,97 @@ void io_scripting_query(); void io_image(); void io_image_query(); -#define NUM_DEVICES 7 +#if defined __GNU_LIBRARY__ || defined __GLIBC__ +size_t strlcat(char *dst, const char *src, size_t dsize); +size_t strlcpy(char *dst, const char *src, size_t dsize); +#endif + +void loadEmbeddedImage(char *arg); + + +/*--------------------------------------------------------------------- + Populate The I/O Device Tables + ---------------------------------------------------------------------*/ typedef void (*Handler)(void); Handler IO_deviceHandlers[NUM_DEVICES + 1] = { - generic_output, + io_output_handler, io_keyboard_handler, io_filesystem_handler, io_floatingpoint_handler, + io_scripting_handler, io_unix_handler, io_gopher_handler, io_image }; Handler IO_queryHandlers[NUM_DEVICES + 1] = { - generic_output_query, + io_output_query, io_keyboard_query, io_filesystem_query, io_floatingpoint_query, + io_scripting_query, io_unix_query, io_gopher_query, io_image_query }; +/*--------------------------------------------------------------------- + Variables Related To Image Introspection + ---------------------------------------------------------------------*/ -void loadEmbeddedImage(char *arg); -void ngaPrepare(); +CELL Compiler; +CELL Dictionary; +CELL NotFound; +CELL interpret; -void generic_output() { + +/*--------------------------------------------------------------------- + Embed The Image + ---------------------------------------------------------------------*/ + +#include "retro-image.c" + + +/*--------------------------------------------------------------------- + Global Variables + ---------------------------------------------------------------------*/ + +char string_data[8192]; +char **sys_argv; +int sys_argc; +int silence_input; + + +/*=====================================================================*/ + + +/*--------------------------------------------------------------------- + Now on to I/O and extensions! + + RRE provides a lot of additional functionality over the base RETRO + system. First up is support for files. + + The RRE file model is intended to be similar to that of the standard + C libraries and wraps fopen(), fclose(), etc. + ---------------------------------------------------------------------*/ + +void io_output_handler() { putc(stack_pop(), stdout); fflush(stdout); } -void generic_output_query() { +void io_output_query() { stack_push(0); stack_push(0); } + +/*=====================================================================*/ + + void io_keyboard_handler() { stack_push(getc(stdin)); if (TOS == 127) TOS = 8; @@ -82,6 +207,56 @@ void io_keyboard_query() { } +/*=====================================================================*/ + + +/*--------------------------------------------------------------------- + Scripting Support + ---------------------------------------------------------------------*/ + +void scripting_arg() { + CELL a, b; + a = stack_pop(); + b = stack_pop(); + stack_push(string_inject(sys_argv[a + 1], b)); +} + +void scripting_arg_count() { + stack_push(sys_argc - 1); +} + +void scripting_include() { + include_file(string_extract(stack_pop()), 0); +} + +void scripting_name() { + stack_push(string_inject(sys_argv[0], stack_pop())); +} + +Handler ScriptingActions[] = { + scripting_arg_count, + scripting_arg, + scripting_include, + scripting_name +}; + +void io_scripting_query() { + stack_push(0); + stack_push(9); +} + +void io_scripting_handler() { + ScriptingActions[stack_pop()](); +} + + +/*=====================================================================*/ + + +/*--------------------------------------------------------------------- + Implement Image Saving + ---------------------------------------------------------------------*/ + void io_image() { FILE *fp; char *f = string_extract(stack_pop()); @@ -99,22 +274,1250 @@ void io_image_query() { } +/*=====================================================================*/ + + +/*--------------------------------------------------------------------- + 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. + + This will also exit if the address stack depth is zero (meaning that + the word being run, and it's dependencies) are finished. + ---------------------------------------------------------------------*/ + +void rre_execute(CELL cell, int silent) { + CELL a, b, token; + CELL opcode; + silence_input = silent; + rp = 1; + ip = cell; + token = TIB; + while (ip < IMAGE_SIZE) { + if (ip == NotFound) { + printf("\nERROR: Word Not Found: "); + printf("`%s`\n\n", string_extract(token)); + } + if (ip == interpret) { + token = TOS; + } + opcode = memory[ip]; + if (ngaValidatePackedOpcodes(opcode) != 0) { + ngaProcessPackedOpcodes(opcode); + } else { + printf("Invalid instruction!\n"); + printf("At %d, opcode %d\n", ip, opcode); + exit(1); + } + if (sp < 0 || sp > STACK_DEPTH) { + printf("\nStack Limits Exceeded!\n"); + printf("At %d, opcode %d\n", ip, opcode); + 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 rre_evaluate(char *s, int silent) { + if (strlen(s) == 0) return; + update_rx(); + string_inject(s, TIB); + stack_push(TIB); + rre_execute(interpret, silent); +} + + +/*--------------------------------------------------------------------- + `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 != 10) && (ch != 13) && (ch != 32) && (ch != EOF) && (ch != 0); +} + +void read_token(FILE *file, char *token_buffer, int echo) { + int ch = getc(file); + int count = 0; + if (echo != 0) + putchar(ch); + 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'; +} + + +/*--------------------------------------------------------------------- + Display the Stack Contents + ---------------------------------------------------------------------*/ + +void dump_stack() { + CELL i; + if (sp == 0) return; + printf("\nStack: "); + for (i = 1; i <= sp; i++) { + if (i == sp) + printf("[ TOS: %d ]", data[i]); + else + printf("%d ", data[i]); + } + printf("\n"); +} + + +/*--------------------------------------------------------------------- + RRE is primarily intended to be used in a batch or scripting model. + The `include_file()` function will be used to read the code in the + file, evaluating it as encountered. + + I enforce a literate model, with code in fenced blocks. E.g., + + # This is a test + + Display "Hello, World!" + + ~~~ + 'Hello,_World! puts nl + ~~~ + + RRE will ignore anything outside the `~~~` blocks. To identify if the + current token is the start or end of a block, I provide a `fenced()` + function. + ---------------------------------------------------------------------*/ + +int fenced(char *s) +{ + int a = strcmp(s, "```"); + int b = strcmp(s, "~~~"); + if (a == 0) return 2; + if (b == 0) return 1; + return 0; +} + + +/*--------------------------------------------------------------------- + And now for the actual `include_file()` function. + ---------------------------------------------------------------------*/ + +void include_file(char *fname, int run_tests) { + int inBlock = 0; /* Tracks status of in/out of block */ + char source[64 * 1024]; /* Line buffer [about 64K] */ + char fence[4]; /* Used with `fenced()` */ + + FILE *fp; /* Open the file. If not found, */ + fp = fopen(fname, "r"); /* exit. */ + if (fp == NULL) + return; + + while (!feof(fp)) /* Loop through the file */ + { + read_token(fp, source, 0); + strncpy(fence, source, 3); /* Copy the first three characters */ + fence[3] = '\0'; /* into `fence` to see if we are in */ + if (fenced(fence) > 0) { /* a code block. */ + if (fenced(fence) == 2 && run_tests == 0) { + } else { + if (inBlock == 0) + inBlock = 1; + else + inBlock = 0; + } + } else { + if (inBlock == 1) /* If we are, evaluate token */ + rre_evaluate(source, -1); + } + } + + fclose(fp); +} + + +/*--------------------------------------------------------------------- + `help()` displays a summary of the command line arguments RRE allows. + + This is invoked using `rre -h` + ---------------------------------------------------------------------*/ + +void help(char *exename) { + printf("Scripting Usage: %s filename\n\n", exename); + printf("Interactive Usage: %s [-h] [-i[,fs]] [-s] [-f filename] [-t]\n\n", exename); + printf("Valid Arguments:\n\n"); + printf(" -h\n"); + printf(" Display this help text\n"); + printf(" -i\n"); + printf(" Launches in interactive mode (line buffered)\n"); + printf(" -i,fs\n"); + printf(" Launches in interactive mode (character buffered, full screen)\n"); + printf(" -s\n"); + printf(" Suppress the 'ok' prompt and keyboard echo in interactive mode\n"); + printf(" -f filename\n"); + printf(" Run the contents of the specified file\n"); + printf(" -u filename\n"); + printf(" Use the image in the specified file instead of the internal one\n"); + printf(" -t\n"); + printf(" Run tests (in ``` blocks) in any loaded files\n\n"); +} + + +/*--------------------------------------------------------------------- + `initialize()` sets up Nga and loads the image (from the array in + `image.c`) to memory. + ---------------------------------------------------------------------*/ + +void initialize() { + CELL i; + ngaPrepare(); + for (i = 0; i < ngaImageCells; i++) + memory[i] = ngaImage[i]; + update_rx(); +} + + +/*--------------------------------------------------------------------- + `arg_is()` exists to aid in readability. It compares the first actual + command line argument to a string and returns a boolean flag. + ---------------------------------------------------------------------*/ + +int arg_is(char *argv, char *t) { + return strcmp(argv, t) == 0; +} + + +/*--------------------------------------------------------------------- + Main Entry Point + ---------------------------------------------------------------------*/ + +enum flags { + FLAG_HELP, FLAG_RUN_TESTS, FLAG_INCLUDE, FLAG_INTERACTIVE, FLAG_SILENT, + FLAG_FULLSCREEN +}; + int main(int argc, char **argv) { + sys_argc = argc; /* Point the global argc and */ + sys_argv = argv; /* argv to the actual ones */ + ngaPrepare(); loadEmbeddedImage(argv[0]); update_rx(); - execute(0); + rre_execute(0, 0); exit(0); } -/* Nga ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - Copyright (c) 2008 - 2018, Charles Childers - Copyright (c) 2009 - 2010, Luke Parrish - Copyright (c) 2010, Marc Simpson - Copyright (c) 2010, Jay Skeer - Copyright (c) 2011, Kenneth Keating - ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */ +/*=====================================================================*/ + + +/*--------------------------------------------------------------------- + File Handling + ---------------------------------------------------------------------*/ + + +/*--------------------------------------------------------------------- + I keep an array of file handles. RETRO will use the index number as + its representation of the file. + ---------------------------------------------------------------------*/ + +FILE *OpenFileHandles[MAX_OPEN_FILES]; + +/*--------------------------------------------------------------------- + `files_get_handle()` returns a file handle, or 0 if there are no + available handle slots in the array. + ---------------------------------------------------------------------*/ + +CELL files_get_handle() { + CELL i; + for(i = 1; i < MAX_OPEN_FILES; i++) + if (OpenFileHandles[i] == 0) + return i; + return 0; +} + + +/*--------------------------------------------------------------------- + `file_open()` opens a file. This pulls from the RETRO data stack: + + - mode (number, TOS) + - filename (string, NOS) + + Modes are: + + | Mode | Corresponds To | Description | + | ---- | -------------- | -------------------- | + | 0 | rb | Open for reading | + | 1 | w | Open for writing | + | 2 | a | Open for append | + | 3 | rb+ | Open for read/update | + + The file name should be a NULL terminated string. This will attempt + to open the requested file and will return a handle (index number + into the `OpenFileHandles` array). + ---------------------------------------------------------------------*/ + +void file_open() { + CELL slot, mode, name; + char *request; + slot = files_get_handle(); + mode = data[sp]; sp--; + name = data[sp]; sp--; + request = string_extract(name); + if (slot > 0) { + if (mode == 0) OpenFileHandles[slot] = fopen(request, "rb"); + if (mode == 1) OpenFileHandles[slot] = fopen(request, "w"); + if (mode == 2) OpenFileHandles[slot] = fopen(request, "a"); + if (mode == 3) OpenFileHandles[slot] = fopen(request, "rb+"); + } + if (OpenFileHandles[slot] == NULL) { + OpenFileHandles[slot] = 0; + slot = 0; + } + stack_push(slot); +} + + +/*--------------------------------------------------------------------- + `file_read()` reads a byte from a file. This takes a file pointer + from the stack and pushes the character that was read to the stack. + ---------------------------------------------------------------------*/ + +void file_read() { + CELL slot = stack_pop(); + CELL c = fgetc(OpenFileHandles[slot]); + stack_push(feof(OpenFileHandles[slot]) ? 0 : c); +} + + +/*--------------------------------------------------------------------- + `file_write()` writes a byte to a file. This takes a file pointer + (TOS) and a byte (NOS) from the stack. It does not return any values + on the stack. + ---------------------------------------------------------------------*/ + +void file_write() { + CELL slot, c, r; + slot = stack_pop(); + c = stack_pop(); + r = fputc(c, OpenFileHandles[slot]); + c = (r == EOF) ? 0 : 1; +} + + +/*--------------------------------------------------------------------- + `file_close()` closes a file. This takes a file handle from the + stack and does not return anything on the stack. + ---------------------------------------------------------------------*/ + +void file_close() { + fclose(OpenFileHandles[data[sp]]); + OpenFileHandles[data[sp]] = 0; + sp--; +} + + +/*--------------------------------------------------------------------- + `file_get_position()` provides the current index into a file. This + takes the file handle from the stack and returns the offset. + ---------------------------------------------------------------------*/ + +void file_get_position() { + CELL slot = stack_pop(); + stack_push((CELL) ftell(OpenFileHandles[slot])); +} + + +/*--------------------------------------------------------------------- + `file_set_position()` changes the current index into a file to the + specified one. This takes a file handle (TOS) and new offset (NOS) + from the stack. + ---------------------------------------------------------------------*/ + +void file_set_position() { + CELL slot, pos, r; + slot = stack_pop(); + pos = stack_pop(); + r = fseek(OpenFileHandles[slot], pos, SEEK_SET); +} + + +/*--------------------------------------------------------------------- + `file_get_size()` returns the size of a file, or 0 if empty. If the + file is a directory, it returns -1. It takes a file handle from the + stack. + ---------------------------------------------------------------------*/ + +void file_get_size() { + CELL slot, current, r, size; + struct stat buffer; + int status; + slot = stack_pop(); + status = fstat(fileno(OpenFileHandles[slot]), &buffer); + if (!S_ISDIR(buffer.st_mode)) { + current = ftell(OpenFileHandles[slot]); + r = fseek(OpenFileHandles[slot], 0, SEEK_END); + size = ftell(OpenFileHandles[slot]); + fseek(OpenFileHandles[slot], current, SEEK_SET); + } else { + r = -1; + } + stack_push((r == 0) ? size : 0); +} + + +/*--------------------------------------------------------------------- + `file_delete()` removes a file. This takes a file name (as a string) + from the stack. + ---------------------------------------------------------------------*/ + +void file_delete() { + char *request; + CELL name = data[sp]; sp--; + CELL result; + request = string_extract(name); + result = (unlink(request) == 0) ? -1 : 0; +} + + +/*--------------------------------------------------------------------- + `file_flush()` flushes any pending writes to disk. This takes a + file handle from the stack. + ---------------------------------------------------------------------*/ + +void file_flush() { + CELL slot; + slot = stack_pop(); + fflush(OpenFileHandles[slot]); +} + + +Handler FileActions[10] = { + file_open, + file_close, + file_read, + file_write, + file_get_position, + file_set_position, + file_get_size, + file_delete, + file_flush +}; + +void io_filesystem_query() { + stack_push(0); + stack_push(4); +} + +void io_filesystem_handler() { + FileActions[stack_pop()](); +} + + +/*=====================================================================*/ + + +/*--------------------------------------------------------------------- + Floating Point + ---------------------------------------------------------------------*/ + +/*--------------------------------------------------------------------- + I have a stack of floating point values ("floats") and a stack + pointer (`fsp`). + ---------------------------------------------------------------------*/ + +double Floats[8192]; +CELL fsp; + +double AFloats[8192]; +CELL afsp; + + +/*--------------------------------------------------------------------- + The first two functions push a float to the stack and pop a value off + the stack. + ---------------------------------------------------------------------*/ + +void float_push(double value) { + fsp++; + Floats[fsp] = value; +} + +double float_pop() { + fsp--; + return Floats[fsp + 1]; +} + +void float_to_alt() { + afsp++; + AFloats[afsp] = float_pop(); +} + +void float_from_alt() { + float_push(AFloats[afsp]); + afsp--; +} + + +/*--------------------------------------------------------------------- + RETRO operates on 32-bit signed integer values. This function just + pops a number from the data stack, casts it to a float, and pushes it + to the float stack. + ---------------------------------------------------------------------*/ +void float_from_number() { + float_push((double)stack_pop()); +} + + +/*--------------------------------------------------------------------- + To get a float from a string in the image, I provide this function. + I cheat: using `atof()` takes care of the details, so I don't have + to. + ---------------------------------------------------------------------*/ +void float_from_string() { + float_push(atof(string_extract(stack_pop()))); +} + + +/*--------------------------------------------------------------------- + Converting a floating point into a string is slightly more work. Here + I pass it off to `snprintf()` to deal with. + ---------------------------------------------------------------------*/ +void float_to_string() { + snprintf(string_data, 8192, "%f", float_pop()); + string_inject(string_data, stack_pop()); +} + + +/*--------------------------------------------------------------------- + Converting a floating point back into a standard number requires a + little care due to the signed nature. This makes adjustments for the + max & min value, and then casts (rounding) the float back to a normal + number. + ---------------------------------------------------------------------*/ + +void float_to_number() { + double a = float_pop(); + if (a > 2147483647) + a = 2147483647; + if (a < -2147483648) + a = -2147483648; + stack_push((CELL)round(a)); +} + + +/*--------------------------------------------------------------------- + Now I get to define a bunch of functions that operate on floats. + These provide the basic math, and wrappers around functionality in + libm. + ---------------------------------------------------------------------*/ + +void float_add() { + double a = float_pop(); + double b = float_pop(); + float_push(a+b); +} + +void float_sub() { + double a = float_pop(); + double b = float_pop(); + float_push(b-a); +} + +void float_mul() { + double a = float_pop(); + double b = float_pop(); + float_push(a*b); +} + +void float_div() { + double a = float_pop(); + double b = float_pop(); + float_push(b/a); +} + +void float_floor() { + float_push(floor(float_pop())); +} + +void float_ceil() { + float_push(ceil(float_pop())); +} + +void float_eq() { + double a = float_pop(); + double b = float_pop(); + if (a == b) + stack_push(-1); + else + stack_push(0); +} + +void float_neq() { + double a = float_pop(); + double b = float_pop(); + if (a != b) + stack_push(-1); + else + stack_push(0); +} + +void float_lt() { + double a = float_pop(); + double b = float_pop(); + if (b < a) + stack_push(-1); + else + stack_push(0); +} + +void float_gt() { + double a = float_pop(); + double b = float_pop(); + if (b > a) + stack_push(-1); + else + stack_push(0); +} + +void float_depth() { + stack_push(fsp); +} + +void float_adepth() { + stack_push(afsp); +} + +void float_dup() { + double a = float_pop(); + float_push(a); + float_push(a); +} + +void float_drop() { + float_pop(); +} + +void float_swap() { + double a = float_pop(); + double b = float_pop(); + float_push(a); + float_push(b); +} + +void float_log() { + double a = float_pop(); + double b = float_pop(); + float_push(log(b) / log(a)); +} + +void float_sqrt() { + float_push(sqrt(float_pop())); +} + +void float_pow() { + double a = float_pop(); + double b = float_pop(); + float_push(pow(b, a)); +} + +void float_sin() { + float_push(sin(float_pop())); +} + +void float_cos() { + float_push(cos(float_pop())); +} + +void float_tan() { + float_push(tan(float_pop())); +} + +void float_asin() { + float_push(asin(float_pop())); +} + +void float_acos() { + float_push(acos(float_pop())); +} + +void float_atan() { + float_push(atan(float_pop())); +} + + +/*--------------------------------------------------------------------- + With this finally done, I implement the FPU instructions. + ---------------------------------------------------------------------*/ +Handler FloatHandlers[] = { + float_from_number, float_from_string, float_to_number, float_to_string, + float_add, float_sub, float_mul, float_div, + float_floor, float_ceil, float_sqrt, float_eq, + float_neq, float_lt, float_gt, float_depth, + float_dup, float_drop, float_swap, float_log, + float_pow, float_sin, float_tan, float_cos, + float_asin, float_acos, float_atan, float_to_alt, + float_from_alt, float_adepth, +}; + +void io_floatingpoint_query() { + stack_push(1); + stack_push(2); +} + +void io_floatingpoint_handler() { + FloatHandlers[stack_pop()](); +} + + +/*=====================================================================*/ + + +/*--------------------------------------------------------------------- + Gopher Support + ---------------------------------------------------------------------*/ + +/*--------------------------------------------------------------------- + The first Gopher related function is `error()`, which prints an + error message and exits if there is a problem. + ---------------------------------------------------------------------*/ + +void error(const char *msg) { + perror(msg); + exit(0); +} + + +/*--------------------------------------------------------------------- + `gopher_fetch()` is the part that does all the real work. + ---------------------------------------------------------------------*/ + +void gopher_fetch(char *host, CELL port, char *selector, CELL dest) { + int sockfd, portno, n; + struct sockaddr_in serv_addr; + struct hostent *server; + char data[GOPHER_MAX_FILE_SIZE]; + char buffer[1025]; + + portno = (int)port; + sockfd = socket(AF_INET, SOCK_STREAM, 0); + if (sockfd < 0) + error("ERROR opening socket"); + + server = gethostbyname(host); + if (server == NULL) { + fprintf(stderr,"ERROR, no such host\n"); + exit(0); + } + + bzero(data, GOPHER_MAX_FILE_SIZE); + bzero((char *) &serv_addr, sizeof(serv_addr)); + + serv_addr.sin_family = AF_INET; + bcopy((char *)server->h_addr, + (char *)&serv_addr.sin_addr.s_addr, + server->h_length); + serv_addr.sin_port = htons(portno); + + if (connect(sockfd, (struct sockaddr *) &serv_addr, sizeof(serv_addr)) < 0) + error("ERROR connecting"); + + n = write(sockfd, selector, strlen(selector)); + if (n < 0) + error("ERROR writing to socket"); + + n = write(sockfd, "\n", strlen("\n")); + if (n < 0) + error("ERROR writing to socket"); + + n = 1; + while (n > 0) { + bzero(buffer, 1025); + n = read(sockfd, buffer, 1024); + strlcat(data, buffer, GOPHER_MAX_FILE_SIZE); + } + + close(sockfd); + string_inject(data, dest); + stack_push(strlen(data)); +} + + + +/*--------------------------------------------------------------------- + The last Gopher function, `gopher_handle_request()` pulls the values + needed from the stack and passes them to the `gopher_fetch()` + function. + + This will take the following from the stack (TOS to bottom): + + Selector (NULL terminated string) + Port (Number) + Server (NULL terminated string) + Buffer (Pointer to memory that will hold the received file) + ---------------------------------------------------------------------*/ + +void gopher_handle_request() { + CELL port, dest; + char server[1025], selector[4097]; + strlcpy(selector, string_extract(stack_pop()), 4096); + port = stack_pop(); + strlcpy(server, string_extract(stack_pop()), 1024); + dest = stack_pop(); + gopher_fetch(server, port, selector, dest); +} + +Handler GopherActions[1] = { + gopher_handle_request +}; + +void io_gopher_query() { + stack_push(0); + stack_push(5); +} + +void io_gopher_handler() { + GopherActions[stack_pop()](); +} + + +/*=====================================================================*/ + + +/*--------------------------------------------------------------------- + `unix_open_pipe()` is like `file_open()`, but for pipes. This pulls + from the data stack: + + - mode (number, TOS) + - executable (string, NOS) + + Modes are: + + | Mode | Corresponds To | Description | + | ---- | -------------- | -------------------- | + | 0 | r | Open for reading | + | 1 | w | Open for writing | + | 3 | r+ | Open for read/update | + + The file name should be a NULL terminated string. This will attempt + to open the requested file and will return a handle (index number + into the `OpenFileHandles` array). + + Once opened, you can use the standard file words to read/write to the + process. + ---------------------------------------------------------------------*/ + +void unix_open_pipe() { + CELL slot, mode, name; + char *request; + slot = files_get_handle(); + mode = stack_pop(); + name = stack_pop(); + request = string_extract(name); + if (slot > 0) { + if (mode == 0) OpenFileHandles[slot] = popen(request, "r"); + if (mode == 1) OpenFileHandles[slot] = popen(request, "w"); + if (mode == 3) OpenFileHandles[slot] = popen(request, "r+"); + } + if (OpenFileHandles[slot] == NULL) { + OpenFileHandles[slot] = 0; + slot = 0; + } + stack_push(slot); +} + +void unix_close_pipe() { + pclose(OpenFileHandles[data[sp]]); + OpenFileHandles[data[sp]] = 0; + sp--; +} + +void unix_system() { + system(string_extract(stack_pop())); +} + +void unix_fork() { + stack_push(fork()); +} + +/*--------------------------------------------------------------------- + UNIX provides `execl` to execute a file, with various forms for + arguments provided. + + RRE wraps this in several functions, one for each number of passed + arguments. See the Glossary for details on what each takes from the + stack. Each of these will return the error code if the execution + fails. + ---------------------------------------------------------------------*/ + +void unix_exec0() { + char path[1025]; + strlcpy(path, string_extract(stack_pop()), 1024); + execl(path, path, (char *)0); + stack_push(errno); +} + +void unix_exec1() { + char path[1025]; + char arg0[1025]; + strlcpy(arg0, string_extract(stack_pop()), 1024); + strlcpy(path, string_extract(stack_pop()), 1024); + execl(path, path, arg0, (char *)0); + stack_push(errno); +} + +void unix_exec2() { + char path[1025]; + char arg0[1025], arg1[1025]; + strlcpy(arg1, string_extract(stack_pop()), 1024); + strlcpy(arg0, string_extract(stack_pop()), 1024); + strlcpy(path, string_extract(stack_pop()), 1024); + execl(path, path, arg0, arg1, (char *)0); + stack_push(errno); +} + +void unix_exec3() { + char path[1025]; + char arg0[1025], arg1[1025], arg2[1025]; + strlcpy(arg2, string_extract(stack_pop()), 1024); + strlcpy(arg1, string_extract(stack_pop()), 1024); + strlcpy(arg0, string_extract(stack_pop()), 1024); + strlcpy(path, string_extract(stack_pop()), 1024); + execl(path, path, arg0, arg1, arg2, (char *)0); + stack_push(errno); +} + +void unix_exit() { + exit(stack_pop()); +} + +void unix_getpid() { + stack_push(getpid()); +} + +void unix_wait() { + CELL a; + stack_push(wait(&a)); +} + +void unix_kill() { + CELL a; + a = stack_pop(); + kill(stack_pop(), a); +} + +void unix_write() { + CELL a, b, c; + c = stack_pop(); + b = stack_pop(); + a = stack_pop(); + write(fileno(OpenFileHandles[c]), string_extract(a), b); +} + +void unix_chdir() { + chdir(string_extract(stack_pop())); +} + +void unix_getenv() { + CELL a, b; + a = stack_pop(); + b = stack_pop(); + string_inject(getenv(string_extract(b)), a); +} + +void unix_putenv() { + putenv(string_extract(stack_pop())); +} + +void unix_sleep() { + sleep(stack_pop()); +} + + +/*--------------------------------------------------------------------- + Faster verisons of `n:put` and `s:put` + ---------------------------------------------------------------------*/ + +void unix_io_putn() { + printf("%ld", (long)stack_pop()); +} + +void unix_io_puts() { + printf("%s", string_extract(stack_pop())); +} + + +/*--------------------------------------------------------------------- + Time and Date Functions + ---------------------------------------------------------------------*/ +void unix_time() { + stack_push((CELL)time(NULL)); +} + +void unix_time_day() { + time_t t = time(NULL); + stack_push((CELL)localtime(&t)->tm_mday); +} + +void unix_time_month() { + time_t t = time(NULL); + stack_push((CELL)localtime(&t)->tm_mon + 1); +} + +void unix_time_year() { + time_t t = time(NULL); + stack_push((CELL)localtime(&t)->tm_year + 1900); +} + +void unix_time_hour() { + time_t t = time(NULL); + stack_push((CELL)localtime(&t)->tm_hour); +} + +void unix_time_minute() { + time_t t = time(NULL); + stack_push((CELL)localtime(&t)->tm_min); +} + +void unix_time_second() { + time_t t = time(NULL); + stack_push((CELL)localtime(&t)->tm_sec); +} + +void unix_time_day_utc() { + time_t t = time(NULL); + stack_push((CELL)gmtime(&t)->tm_mday); +} + +void unix_time_month_utc() { + time_t t = time(NULL); + stack_push((CELL)gmtime(&t)->tm_mon + 1); +} + +void unix_time_year_utc() { + time_t t = time(NULL); + stack_push((CELL)gmtime(&t)->tm_year + 1900); +} + +void unix_time_hour_utc() { + time_t t = time(NULL); + stack_push((CELL)gmtime(&t)->tm_hour); +} + +void unix_time_minute_utc() { + time_t t = time(NULL); + stack_push((CELL)gmtime(&t)->tm_min); +} + +void unix_time_second_utc() { + time_t t = time(NULL); + stack_push((CELL)gmtime(&t)->tm_sec); +} + +Handler UnixActions[] = { + unix_system, unix_fork, unix_exec0, unix_exec1, unix_exec2, + unix_exec3, unix_exit, unix_getpid, unix_wait, unix_kill, + unix_open_pipe, unix_close_pipe, unix_write, unix_chdir, unix_getenv, + unix_putenv, unix_sleep, unix_io_putn, unix_io_puts, unix_time, + unix_time_day, unix_time_month, unix_time_year, + unix_time_hour, unix_time_minute, unix_time_second, + unix_time_day_utc, unix_time_month_utc, unix_time_year_utc, + unix_time_hour_utc, unix_time_minute_utc, unix_time_second_utc +}; + +void io_unix_query() { + stack_push(1); + stack_push(8); +} + +void io_unix_handler() { + UnixActions[stack_pop()](); +} + + +/*=====================================================================*/ + + +/*--------------------------------------------------------------------- + Interfacing With The Image + ---------------------------------------------------------------------*/ + +/*--------------------------------------------------------------------- + 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--; + if (sp < 0) { + printf("Data stack underflow.\n"); + exit(1); + } + return data[sp + 1]; +} + +void stack_push(CELL value) { + sp++; + if (sp >= STACK_DEPTH) { + printf("Data stack overflow.\n"); + exit(1); + } + 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 m, i; + if (!str) { + memory[buffer] = 0; + return 0; + } + m = strlen(str); + i = 0; + while (m > 0) { + memory[buffer + i] = (CELL)str[i]; + memory[buffer + i + 1] = 0; + m--; 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_extract(CELL at) { + CELL starting = at; + CELL i = 0; + while(memory[starting] && i < 8192) + 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]; + interpret = d_xt_for("interpret", Dictionary); + NotFound = d_xt_for("err:notfound", Dictionary); + Compiler = d_xt_for("Compiler", Compiler); +} + + +/*=====================================================================*/ + + +/*--------------------------------------------------------------------- + Instruction Processor + ---------------------------------------------------------------------*/ enum vm_opcode { VM_NOP, VM_LIT, VM_DUP, VM_DROP, VM_SWAP, VM_PUSH, VM_POP, @@ -125,9 +1528,32 @@ enum vm_opcode { }; #define NUM_OPS VM_II + 1 -#ifndef NUM_DEVICES -#define NUM_DEVICES 0 -#endif +CELL ngaLoadImage(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); + if (fileLen > IMAGE_SIZE) { + fclose(fp); + printf("Image is larger than alloted space!\n"); + exit(1); + } + 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 ngaPrepare() { ip = sp = rp = 0; @@ -361,10 +1787,99 @@ void ngaProcessPackedOpcodes(CELL opcode) { raw = raw >> 8; } } -#include -#include -#include -#include + + +/*=====================================================================*/ + + +/* + * Copyright (c) 1998, 2015 Todd C. Miller + * + * Permission to use, copy, modify, and distribute this software for any + * purpose with or without fee is hereby granted, provided that the above + * copyright notice and this permission notice appear in all copies. + * + * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES + * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF + * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR + * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES + * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN + * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF + * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. + */ + +#ifndef strlcat +/* + * Appends src to string dst of size dsize (unlike strncat, dsize is the + * full size of dst, not space left). At most dsize-1 characters + * will be copied. Always NUL terminates (unless dsize <= strlen(dst)). + * Returns strlen(src) + MIN(dsize, strlen(initial dst)). + * If retval >= dsize, truncation occurred. + */ +size_t +strlcat(char *dst, const char *src, size_t dsize) +{ + const char *odst = dst; + const char *osrc = src; + size_t n = dsize; + size_t dlen; + + /* Find the end of dst and adjust bytes left but don't go past end. */ + while (n-- != 0 && *dst != '\0') + dst++; + dlen = dst - odst; + n = dsize - dlen; + + if (n-- == 0) + return(dlen + strlen(src)); + while (*src != '\0') { + if (n != 0) { + *dst++ = *src; + n--; + } + src++; + } + *dst = '\0'; + + return(dlen + (src - osrc)); /* count does not include NUL */ +} +#endif + +#ifndef strlcpy +/* + * Copy string src to buffer dst of size dsize. At most dsize-1 + * chars will be copied. Always NUL terminates (unless dsize == 0). + * Returns strlen(src); if retval >= dsize, truncation occurred. + */ +size_t +strlcpy(char *dst, const char *src, size_t dsize) +{ + const char *osrc = src; + size_t nleft = dsize; + + /* Copy as many bytes as will fit. */ + if (nleft != 0) { + while (--nleft != 0) { + if ((*dst++ = *src++) == '\0') + break; + } + } + + /* Not enough room in dst, add NUL and traverse rest of src. */ + if (nleft == 0) { + if (dsize != 0) + *dst = '\0'; /* NUL-terminate dst */ + while (*src++) + ; + } + + return(src - osrc - 1); /* count does not include NUL */ +} +#endif + + +/*=====================================================================*/ + #pragma pack(push,1) #pragma pack(pop) @@ -448,8 +1963,6 @@ typedef struct elf64_shdr { Elf64_Xword sh_entsize; /* Entry size if section holds table */ } Elf64_Shdr; - - void loadEmbeddedImage(char *arg) { FILE* ElfFile = NULL; char* SectNames = NULL; @@ -489,3 +2002,4 @@ void loadEmbeddedImage(char *arg) { } return; } +