/*
 * 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 hprimclass.cdefs_str LUA>>
<<LUA return fprimclass.cdefs_str LUA>>
<<LUA return sfprimclass.cdefs_str LUA>>
<<LUA return fipprimclass.cdefs_str 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	/* use tabs instead of spaces in the stack dumps */
#define DBG_HPRIM 32	/* show the name of each primitive before running it */
#define DBG_FPRIM 64	/* show the name of each primitive before running it */
#define DBG_FIPPRIM 128	/* show the name of each primitive before running it */
void DBG(char *statename, int bit);

#define Hp(str) ((DBG_BITS & DBG_HPRIM) && printf("%s\n", str))
#define Fp(str) ((DBG_BITS & DBG_FPRIM) && printf("%s\n", str))
#define FIPp(str) ((DBG_BITS & DBG_FIPPRIM) && printf("%s\n", str))
#define PRIMp(str) ((DBG_BITS & (32|64|128)) && printf("%s\n", str))


unsigned int SF_TO_F[] = {
<<LUA return sfprimclass.transltable_str LUA>>
0};
/* void *SF_TO_ADR[] = {}; */  /* not being used at this moment */

<<LUA return "/* no C-extras support yet */" 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 fprimclass.case_str LUA>>
  }

 run_forth_ip_primitive:
  instr = RS[0];
  switch (instr) {
<<LUA return fipprimclass.case_str LUA>>
  }

 head: DBG("head ", DBG_HEAD);
  byte = _f0[RS[0]]; RS[0]++;
  switch (byte) {
<<LUA return hprimclass.case_str 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;
}