/*
 * skel.engine.c - the Crim/Flua inner interpreter
 * edrx 2001apr20
 */

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

ushort *RS; int *DS, *SS;

/**[lua return "\n"..strings.Cdefs.."\n"..strings.Cdefs_LAST lua]**/
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 = 0;	/* a bit mask; -1 means to print all debug info */
#define DBG_FORTH 1	/* if set show the stacks in the "forth" states */
#define DBG_HEAD  2	/* if set show the stacks in the "head" states */
#define DBG_OK    4	/* if set print an "ok!" when leaving */
#define DBG_LONGFORM 8	/* use the long form for stack dumps */
#define DBG_USETABS 16	/* usa tabs instead of spaces in the stack dumps */
void DBG(char *statename, int bit);



unsigned int SF_TO_F[] = {
  /**[lua return "\n  " .. strings.SFprims lua]**/
  /* end: */ 0};
/* void *SF_TO_ADR[] = {}; */  /* not being used at this moment */

/**[lua return "\n" .. strings.Cextras1 lua]**/


/*
 * The engine itself.
 */
void engine(void) {
  ushort instr, tmp; uchar byte;
  funptr fun;

  goto head;

 forth: DBG("forth", DBG_FORTH);
  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) {
    /**[lua return "\n"..strings.Fprims lua]**/
  }

 run_forth_ip_primitive:
  instr = RS[0];
  switch (instr) {
    /**[lua return "\n"..strings.FIPprims lua]**/
  }

 head: DBG("head ", DBG_HEAD);
  byte = _f0[RS[0]]; RS[0]++;
  switch (byte) {
    /**[lua return "\n"..strings.Hprims lua]**/
  }
}



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

/*
 * Make the engine execute the word "DEMO"
 *
 */
extern uchar ADR_DEMO[];
int main(int argc, char **argv) {
  if (argc>1) DBG_BITS = atoi(argv[1]); /* use argv[1] to set the debug bits */
  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();

  if (DBG_BITS & DBG_OK)
    printf("Ok!\n");
  return 0;
}