retroforth/vm/nga-c-no-libc/retro.c

/* RETRO is a clean, elegant, and pragmatic dialect of Forth. It provides
   a simple alternative for those willing to make a break from legacy
   systems.

   The language draws influences from many sources including traditional
   Forth systems, cmForth, colorForth, Factor, and Parable. It was
   designed to be easy to grasp and adapt to specific uses.

   The basic language is very portable and runs on a tiny virtual machine.

   This file contains a minimal implementation of the virtual machine.

   Copyright (c) 2008 - 2022, Charles Childers
   Copyright (c) 2009 - 2010, Luke Parrish
   Copyright (c) 2010,        Marc Simpson
   Copyright (c) 2010,        Jay Skeer
   Copyright (c) 2011,        Kenneth Keating
*/


#define CELL     int
#define CELL_MIN -2147483647
#define CELL_MAX 2147483646

#define IMAGE_SIZE   524288       /* Amount of RAM.          */
#define ADDRESSES    128          /* Max address stack depth */
#define STACK_DEPTH   32          /* Max data stack depth    */

CELL sp, rp, ip;                  /* Stack and instruction pointers */
CELL data[STACK_DEPTH];           /* The data stack          */
CELL address[ADDRESSES];          /* The address stack       */
CELL memory[IMAGE_SIZE + 1];      /* Image Memory            */

#define TOS  data[sp]             /* Top item on stack       */
#define NOS  data[sp-1]           /* Second item on stack    */
#define TORS address[rp]          /* Top item on address stack */

typedef void (*Handler)(void);

#include "image.c"

int getchar(void);
int putchar(int c);

CELL stack_pop();
void stack_push(CELL value);
void execute(CELL cell);
void prepare_vm();
void process_opcode_bundle(CELL opcode);

CELL stack_pop() {
  sp--;
  return data[sp + 1];
}

void stack_push(CELL value) {
  sp++;
  data[sp] = value;
}

void execute(CELL cell) {
  CELL opcode;
  rp = 1;
  ip = cell;
  while (ip < IMAGE_SIZE) {
    opcode = memory[ip];
    process_opcode_bundle(opcode);
    ip++;
    if (rp == 0)
      ip = IMAGE_SIZE;
  }
}

int main(int argc, char **argv) {
  prepare_vm();

  for (CELL i = 0; i < ngaImageCells; i++)
    memory[i] = ngaImage[i];

  execute(0);
}

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() {
  ip++;
  stack_push(memory[ip]);
}

void inst_du() {
  stack_push(TOS);
}

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() {
  stack_push(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 << (0 - TOS);
  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(2);
}

void inst_iq() {
  if (TOS == 0) {
    inst_dr();
    stack_push(0);
    stack_push(0);
  } else if (TOS == 1) {
    inst_dr();
    stack_push(1);
    stack_push(1);
  }
}

void inst_ii() {
  if (TOS == 0) {
    inst_dr();
    putchar(stack_pop());
  } else if (TOS == 1) {
    inst_dr();
    stack_push(getchar());
  } else {
    inst_dr();
  }
}

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_bundle(CELL opcode) {
  instructions[opcode & 0xFF]();
  instructions[(opcode >> 8) & 0xFF]();
  instructions[(opcode >> 16) & 0xFF]();
  instructions[(opcode >> 24) & 0xFF]();
}