/*
 * Crim: kernel (as a PFE primitive word)
 *
 * version: 95 jun 18
 *          crim.c
 *
 * Status: working (only H_VALUE_3 is untested)
 *
 */


#include "forth.h"

void crim_error(void) { }	/* called on error. Set a breakpoint here */

Xt crim_stepper;
#define _D() call_forth(crim_stepper)

typedef unsigned char u1;	/* unsigned (one byte) */
typedef unsigned short u2;
typedef unsigned int u4;

typedef signed char s1;		/* signed (one byte) */
typedef signed short s2;
typedef signed int s4;

#define drw_u1(p) (*(((u1 *)(p))++)) /* data read and walk: u1 */
#define drw_u2(p) (*(((u2 *)(p))++))
#define drw_u4(p) (*(((u4 *)(p))++))

#define drw_s1(p) (*(((s1 *)(p))++)) 
#define drw_s2(p) (*(((s2 *)(p))++))
#define drw_s4(p) (*(((s4 *)(p))++))



/* Note:
 * every H_xxx is a head and a state at the same time
 */

enum {
  H_CRIM      = 0,
  H_FORTH     = 1,
  H_RSR       = 2,
  H_VALUE_1   = 3,		/* first head of a VALUE */
  H_VALUE_2   = 4,		/* second head */
  H_VALUE_3   = 5,		/* third head */

  HEAD_STATE  = 256,		/* a special state */

/* short Crim instructions */

  S_EXIT      = 255,
  S_SEXIT     = 254,
  S_LIT4      = 253,
  S_END_CRIM  = 252,
};



#define FIRST_SHORT S_END_CRIM  /* used to decide which instructions
				   are short. At present every Crim
				   primitive is a short instruction,
				   and every long (two bytes)
				   instruction is a function call. */

u1 *CRIM_BEGMEM;		/* for two-byte function calls */

#define __ST(s) case s: _L_##s:;

#define goto__ST(s) crim_state=s; _D();\
		    goto _L_##s	/* goto__ST would have other definition
				   outside the Crim kernel */

#define reswitch goto _L_reswitch /* reswitch too */

#define goto__ST_(s) crim_state=s; \
		    goto _L_##s	/* used for jumping to short instructions */



#define DS ((u4 *)sp)		/* Crim uses PFE's data stack */
u4 *RS;
u4 *SS;

#define ip (*RS)		/* ...and ignores PFE's ip completely */


#define pushd(x) (*--DS=(u4)(x))
#define pushr(x) (*--RS=(u4)(x)) /* note that ip is defined as *RS */
#define pushs(x) (*--SS=(u4)(x))
#define popd()  (*(DS++))
#define popr()  (*(RS++))
#define pops()  (*(SS++))
#define popdsto(x) (((u4)(x))=popd())

int crim_state;

void
crim()
{
    _L_reswitch:				_D();
    switch(crim_state) {
	__ST(HEAD_STATE)
	  crim_state = drw_u1(ip);
	  reswitch;

	__ST(H_CRIM)
	{ u1 x1=drw_u1(ip);
	  u2 x2;
	  if(x1>=FIRST_SHORT) {
		switch(x1) {
		    __ST(S_EXIT)
		      popr();
		      goto__ST(H_CRIM);
		    __ST(S_SEXIT)
		      ip=pops();
		      goto__ST(H_CRIM);
		    __ST(S_LIT4)
		      pushd(drw_u4(ip));
		      goto__ST(H_CRIM);
		    __ST(S_END_CRIM)
		      return;
		    default:
		      crim_error();
		}
	  } else {
		x2=x1*256+drw_u1(ip);
		pushr(x2+CRIM_BEGMEM);
		goto__ST(HEAD_STATE);
	  }
	}

	__ST(H_FORTH)
	  call_forth((Xt)drw_u4(ip));
	  goto__ST_(S_EXIT);

	__ST(H_VALUE_1)
	  pushd(drw_u4(ip));
	  goto__ST_(S_EXIT);

	__ST(H_VALUE_2)
	  ((u4)ip)+=1;
	  *(u4 *)ip=popd();
	  goto__ST_(S_EXIT);

	__ST(H_VALUE_3)
	  pushd(((u4)ip)+2);
	  goto__ST_(S_EXIT);

	__ST(H_RSR)
	  pushs(RS[1]);
	  RS[1]=CRIM_BEGMEM+1;
	  goto__ST(HEAD_STATE);

        default:
	  crim_error();
    }
}

Code (pfe_crim)			{ crim(); }
Code (pfe_crim_state)		{ pushd(crim_state); }
Code (pfe_crim_state_sto)	{ popdsto(crim_state); }
Code (pfe_crim_rs)		{ pushd(RS); }
Code (pfe_crim_ss)		{ pushd(SS); }
Code (pfe_crim_rs_sto)		{ popdsto(RS); }
Code (pfe_crim_ss_sto)		{ popdsto(SS); }
Code (pfe_crim_begmem)		{ pushd(CRIM_BEGMEM); }
Code (pfe_crim_begmem_sto)	{ popdsto(CRIM_BEGMEM); }
Code (pfe_crim_stepper_sto)	{ popdsto(crim_stepper); }

LISTWORDS (crim) =
{ CO ("CRIM-ENGINE",	pfe_crim),
  CO ("CRIM-STATE",	pfe_crim_state),
  CO ("CRIM-STATE!",	pfe_crim_state_sto),
  CO ("CRIMRS",		pfe_crim_rs),
  CO ("CRIMSS",		pfe_crim_ss),
  CO ("CRIMRS!",	pfe_crim_rs_sto),
  CO ("CRIMSS!",	pfe_crim_ss_sto),
  CO ("CRIM-BEGMEM",    pfe_crim_begmem),
  CO ("CRIM-BEGMEM!",   pfe_crim_begmem_sto),
  CO ("CRIM-STEPPER!",	pfe_crim_stepper_sto),
};
COUNTWORDS (crim, "Crim interpreter");