/*
 * 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]*/
#define H_C1             0x00
#define H_RSR            0x01
#define H_COL            0x02
#define FIP_RETURN       0xFFFF
#define FIP_RSREXIT      0xFFFE
#define FIP_FIPDROP      0xFFFD
#define SF_EXIT          0xFF
#define SF_DUP           0xFE
#define F_EXIT           0xFDFF
#define F_STO            0xFDFE
#define F_DUP            0xFDFD
#define F_2DUP           0xFDFC
#define F_TYPE           0xFDFB
#define F_PLUS           0xFDFA
#define F_1              0xFDF9
#define F_TOS            0xFDF8

#define H_LAST           0x02
#define FIP_LAST         0xFFFD
#define SF_LAST          0xFE
#define F_LAST           0xFDF8

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]*/
  F_EXIT, F_DUP, 
  /* 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]*/
case F_EXIT:  RS--; goto forth;
case F_STO:  DS[1]=SS[0]; DS++; SS--; goto forth;
case F_DUP:  DS[1]=DS[0]; DS++; goto forth;
case F_2DUP:  DS[1]=DS[-1]; DS[2]=DS[0]; DS+=2; goto forth;
case F_TYPE:  fwrite((void *)(DS[-1]), 1, DS[0], stdout); DS-=2; goto forth;
case F_PLUS:  DS[-1]+=DS[0]; DS--; goto forth;
case F_1:  DS[1]=1; DS++; goto forth;
case F_TOS:  SS[1]=DS[0]; SS++; DS--; goto forth;

  }

 run_forth_ip_primitive:
  instr = RS[0];
  switch (instr) {
    /*[lua return "\n"..strings.FIPprims lua]*/
case FIP_RETURN:  RS--; return;
case FIP_RSREXIT:  RS[0]=SS[0]-((int)_f0); SS--; goto forth;
case FIP_FIPDROP:  RS--; DS--; goto forth;

  }

 head: DBG("head ", DBG_HEAD);
  byte = _f0[RS[0]]; RS[0]++;
  switch (byte) {
    /*[lua return "\n"..strings.Hprims lua]*/
case H_C1:  fun=*(funptr *)(_f0+RS[0]); DS[0]=(*fun)(DS[0]); RS--; goto forth;
case H_RSR:  SS[1]=((int)_f0)+RS[-1]; SS++; RS[-1]=FIP_RSREXIT; goto head;
case H_COL:  goto forth;

  }
}



/*
 * 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;
}