retroforth/interfaces/barebones.c
crc 748cbcfd72 new implementation aiming to minimize the C portion of the code
FossilOrigin-Name: 4709c022b1cd034c0d12c01fe1ebce0185a6d14a53a2768fe9f134a6013d0f79
2018-10-01 14:56:49 +00:00

321 lines
6.1 KiB
C

/* RETRO -------------------------------------------------------------
A personal, minimalistic forth
Copyright (c) 2016 - 2018 Charles Childers
---------------------------------------------------------------------*/
#include <stdio.h>
#include <stdint.h>
#include <stdlib.h>
#define CELL int32_t /* Cell size (32 bit, signed integer */
#define IMAGE_SIZE 524288 * 8 /* Amount of RAM. 4MiB by default. */
#define ADDRESSES 1024 /* 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 */
#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;
}
#define IO_TTY_PUTC 1000
#define IO_TTY_GETC 1001
void execute(CELL cell) {
CELL opcode;
rp = 1;
ip = cell;
while (ip < IMAGE_SIZE) {
opcode = memory[ip];
if (ngaValidatePackedOpcodes(opcode) != 0) {
ngaProcessPackedOpcodes(opcode);
} else {
switch (opcode) {
case IO_TTY_PUTC:
putc(stack_pop(), stdout);
fflush(stdout);
break;
case IO_TTY_GETC:
stack_push(getc(stdin));
if (TOS == 127) TOS = 8;
break;
default:
printf("Invalid instruction!\n");
exit(1);
}
}
ip++;
if (rp == 0)
ip = IMAGE_SIZE;
}
}
int main(int argc, char **argv) {
ngaPrepare();
ngaLoadImage();
execute(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
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ */
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
};
#define NUM_OPS VM_END + 1
CELL ngaLoadImage() {
for (int i = 0; i < ngaImageCells; i++)
memory[i] = ngaImage[i];
return ngaImageCells;
}
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;
}
typedef void (*Handler)(void);
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
};
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 <= 26))
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;
}
}