/* RETRO ------------------------------------------------------ A personal, minimalistic forth Copyright (c) 2016 - 2019 Charles Childers ---------------------------------------------------------- */ #include #include #include #define CELL int32_t /* Cell size (32 bit, signed integer */ #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 */ #define NUM_DEVICES 2 typedef void (*Handler)(void); Handler IO_deviceHandlers[NUM_DEVICES + 1]; Handler IO_queryHandlers[NUM_DEVICES + 1]; #include "barebones_image.c" CELL stack_pop(); void stack_push(CELL value); void execute(CELL cell); CELL ngaLoadImage(); void ngaPrepare(); void ngaProcessOpcode(CELL opcode); void ngaProcessPackedOpcodes(CELL opcode); int ngaValidatePackedOpcodes(CELL opcode); CELL stack_pop() { sp--; return data[sp + 1]; } void stack_push(CELL value) { sp++; data[sp] = value; } void generic_output() { putc(stack_pop(), stdout); fflush(stdout); } void generic_output_query() { stack_push(0); stack_push(0); } void generic_input() { stack_push(getc(stdin)); if (TOS == 127) TOS = 8; } void generic_input_query() { stack_push(0); stack_push(1); } void execute(CELL cell) { CELL opcode; rp = 1; ip = cell; while (ip < IMAGE_SIZE) { opcode = memory[ip]; if (ngaValidatePackedOpcodes(opcode) != 0) { ngaProcessPackedOpcodes(opcode); } else { printf("Invalid instruction!\n"); exit(1); } ip++; if (rp == 0) ip = IMAGE_SIZE; } } int main(int argc, char **argv) { IO_deviceHandlers[0] = generic_output; IO_deviceHandlers[1] = generic_input; IO_queryHandlers[0] = generic_output_query; IO_queryHandlers[1] = generic_input_query; ngaPrepare(); ngaLoadImage(); execute(0); exit(0); } /* Nga ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Copyright (c) 2008 - 2019, Charles Childers Copyright (c) 2009 - 2010, Luke Parrish Copyright (c) 2010, Marc Simpson Copyright (c) 2010, Jay Skeer Copyright (c) 2011, Kenneth Keating ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */ enum vm_opcode { VM_NOP, VM_LIT, VM_DUP, VM_DROP, VM_SWAP, VM_PUSH, VM_POP, VM_JUMP, VM_CALL, VM_CCALL, VM_RETURN, VM_EQ, VM_NEQ, VM_LT, VM_GT, VM_FETCH, VM_STORE, VM_ADD, VM_SUB, VM_MUL, VM_DIVMOD, VM_AND, VM_OR, VM_XOR, VM_SHIFT, VM_ZRET, VM_END, VM_IE, VM_IQ, VM_II }; #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); 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; for (ip = 0; ip < IMAGE_SIZE; ip++) memory[ip] = VM_NOP; for (ip = 0; ip < STACK_DEPTH; ip++) data[ip] = 0; for (ip = 0; ip < ADDRESSES; ip++) address[ip] = 0; } void inst_nop() { } void inst_lit() { sp++; ip++; TOS = memory[ip]; } void inst_dup() { sp++; data[sp] = NOS; } void inst_drop() { data[sp] = 0; if (--sp < 0) ip = IMAGE_SIZE; } void inst_swap() { CELL a; a = TOS; TOS = NOS; NOS = a; } void inst_push() { rp++; TORS = TOS; inst_drop(); } void inst_pop() { sp++; TOS = TORS; rp--; } void inst_jump() { ip = TOS - 1; inst_drop(); } void inst_call() { rp++; TORS = ip; ip = TOS - 1; inst_drop(); } void inst_ccall() { CELL a, b; a = TOS; inst_drop(); /* False */ b = TOS; inst_drop(); /* Flag */ if (b != 0) { rp++; TORS = ip; ip = a - 1; } } void inst_return() { ip = TORS; rp--; } void inst_eq() { NOS = (NOS == TOS) ? -1 : 0; inst_drop(); } void inst_neq() { NOS = (NOS != TOS) ? -1 : 0; inst_drop(); } void inst_lt() { NOS = (NOS < TOS) ? -1 : 0; inst_drop(); } void inst_gt() { NOS = (NOS > TOS) ? -1 : 0; inst_drop(); } void inst_fetch() { switch (TOS) { case -1: TOS = sp - 1; break; case -2: TOS = rp; break; case -3: TOS = IMAGE_SIZE; break; default: TOS = memory[TOS]; break; } } void inst_store() { if (TOS <= IMAGE_SIZE && TOS >= 0) { memory[TOS] = NOS; inst_drop(); inst_drop(); } else { ip = IMAGE_SIZE; } } void inst_add() { NOS += TOS; inst_drop(); } void inst_sub() { NOS -= TOS; inst_drop(); } void inst_mul() { NOS *= TOS; inst_drop(); } void inst_divmod() { CELL a, b; a = TOS; b = NOS; TOS = b / a; NOS = b % a; } void inst_and() { NOS = TOS & NOS; inst_drop(); } void inst_or() { NOS = TOS | NOS; inst_drop(); } void inst_xor() { NOS = TOS ^ NOS; inst_drop(); } void inst_shift() { 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_drop(); } void inst_zret() { if (TOS == 0) { inst_drop(); ip = TORS; rp--; } } void inst_end() { ip = IMAGE_SIZE; } void inst_ie() { sp++; TOS = NUM_DEVICES; } void inst_iq() { CELL Device = TOS; inst_drop(); IO_queryHandlers[Device](); } void inst_ii() { CELL Device = TOS; inst_drop(); IO_deviceHandlers[Device](); } Handler instructions[NUM_OPS] = { inst_nop, inst_lit, inst_dup, inst_drop, inst_swap, inst_push, inst_pop, inst_jump, inst_call, inst_ccall, inst_return, inst_eq, inst_neq, inst_lt, inst_gt, inst_fetch, inst_store, inst_add, inst_sub, inst_mul, inst_divmod, inst_and, inst_or, inst_xor, inst_shift, inst_zret, inst_end, inst_ie, inst_iq, inst_ii }; void ngaProcessOpcode(CELL opcode) { if (opcode != 0) instructions[opcode](); } int ngaValidatePackedOpcodes(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 ngaProcessPackedOpcodes(CELL opcode) { CELL raw = opcode; int i; for (i = 0; i < 4; i++) { ngaProcessOpcode(raw & 0xFF); raw = raw >> 8; } }