/*
 * engine0.c - a Crim engine
 * edrx 2000jul19
 * This is just a proof-of-concept implementation: easy to debug, not
 * optimized at all, and very small. It has only the code necessary to
 * run one simple example.
 * (find-es "crim" "compiling")
 */

#include <stdio.h>
typedef unsigned int   uint;
typedef unsigned char  uchar;
typedef unsigned short ushort;

ushort *RS; int *DS, *SS;
/* extern uchar _f0[]; */

int underflow[100];

ushort _RS0[100]; int _DS0[100], _SS0[100];

#define RDEPTH ((RS-_RS0)+1)
#define DDEPTH ((DS-_DS0)+1)
#define SDEPTH ((SS-_SS0)+1)
int DBG_BITS = -1;		/* print debug info at all states */
void DBG(char *statename, int bit);


/*
 * The engine itself.
 * Implements the primitives that can be #defined by:
 *	HPRIM'' COL	:
 *	HPRIM'  CON
 *	SFPRIM'' EXIT	;
 *	SFPRIM'' TIMES	*
 *	SFPRIM'  DUP
 *	FIPPRIM' RETURN
 * (But you can change FPRIM<->SFPRIM in some lines and the
 * preprocessor will take care of the details.)
 */
void engine(void) {
  ushort instr; uchar byte;

  goto head;

 forth: DBG("forth", 2);
  if (RS[0] >= FIP_LAST)	/* ip primitive? */
    goto run_forth_ip_primitive;
  byte = _f0[RS[0]]; RS[0]++;
  if (byte >= SF_LAST) {	/* one-byte instruction? */
    instr = SF_TO_F[255 - byte];
    goto run_forth_instr;
  } else {			/* it's a normal call */
    instr = (byte << 8) | _f0[RS[0]]; RS[0]++;
    goto run_forth_instr;
  }
  
 run_forth_instr:
  if (instr >= F_LAST)
    goto run_forth_primitive;
  
 run_forth_call:
  RS++; RS[0] = instr;
  goto head;
  
 run_forth_primitive:
  switch (instr) {
  case F_EXIT: RS--; goto forth;
  case F_TIMES: DS[-1]*=DS[0]; DS--; goto forth;
  case F_DUP: DS[1]=DS[0]; DS++; goto forth;
  }

 run_forth_ip_primitive:
  instr = RS[0];
  switch (instr) {
  case FIP_RETURN: RS--; return;
  }

 head: DBG("head ", 1);
  byte = _f0[RS[0]]; RS[0]++;
  /* only the most basic primitive heads
   * (gdb "gdb ~/CRIM1/demo0")
   */
  switch (byte) {
  case H_COL: goto forth;
  case H_CON: DS[1]=*(int *)(_f0+RS[0]); DS++; RS--; goto forth;
  }
}



/*
 * Debugging routines called by the engine.
 *
 */
void dbg_print_int(int x) {
  uint w = (uchar *)x - _f0;
  if (w<=0xFFFF)
    printf(" _f0+%x", w);
  else
    printf(" %x", x);
}
void DBG(char *statename, int bit) {
  int i;
  if ((bit&DBG_BITS)==0) return;
  printf("state=%s R::", statename);
  for (i=-RDEPTH+1; i<=0; ++i)
    printf(" %x", RS[i]);
  printf("\t S::");
  for (i=-SDEPTH+1; i<=0; ++i)
    dbg_print_int(SS[i]);
  printf("\t D::");
  for (i=-DDEPTH+1; i<=0; ++i)
    dbg_print_int(DS[i]);
  printf("\n");
}

/*
 * A demo...
 *
 */
extern uchar ADR_DEMO[];
main(int argc, char **argv) {
  if (argc>1) DBG_BITS = atoi(argv[1]);
  RS = _RS0 + 1;		/* depth 2 (RS[-1] is valid, RS[-2] isn't) */
  DS = _DS0 - 1;		/* depth 0 */
  SS = _SS0 - 1;		/* depth 0 */
  RS[-1] = FIP_RETURN;
  RS[0] = 0x1F;

  RS[0] = ADR_DEMO - _f0;
  engine();
  printf("Ok!\n");
}