gistfile1.c

/* OPCODES:
 * -------
 * OP_SETABC(a,b,c)
 *	frame->A = frame[a] etc
 *	set "segments" for each a, b, c (-1 do not set anything for given letter)
 *	arguments must refer to valid TT_TAGGED tables.
 * OP_GETT(a,b,c)
 *	A[a] = B[b][C[c]] if table
 *	OR A[a] = B[b](->self,C[c]) if function call
 * OP_SETT(a=val,b=tab,c=key)
 *	B[b][C[c]] = A[a]
 *
 * any invalid table operation will trigger global exception frame
 * which should deal with it further (ie. metatables)
 *
 * OP_EQ(a,b,c)
 *	if (!memcmp(b,c,8)) goto a;
 *	does binary equation test and if equal, jumps.
 * OP_TEST(jmplong,val)
 *	if val is true, jump.
 * OP_RET(unused,func,arg) returns from a function, optionally performing a tailcall
 *
 * math ops:
 * non-integer values trigger exceptions.
 *
 * OP_LT(dst,b,c) substract b-c, if b<c, jump.
 * OP_+{BAND,BOR,BXOR,BSHL,BSHR,ADD,SUB,MUL,DIV,MOD} = 11 math ops of OP_*(a,b,c)
 */

asm(".code16gcc\n");

#define MKH(v) ((v.u>>32)^(v.u&0xffffffffLL))
#include <stdint.h>
#include <stdlib.h>
#include <string.h>

enum {
OP_setabc, OP_gett, OP_sett, OP_eq, OP_test, OP_ret, OP_lt,
OP_band, OP_bor, OP_bxor, OP_bshl, OP_bshr, OP_add, OP_sub, OP_mul, OP_div, OP_mod };

/* tagged doubles are 0xffff000T<val>
 * T cane be one of TT:
 */
#define TT_TAGGED	0 /* the table has tagged values OR doubles */
#define TT_OBJECT	1 /* string, userdata ... can have meta ... NULL OBJECT is NULL */
#define TT_SYMBOL  	2
#define	TT_BOOL		3 /* bitmap in table */

#define	TT_INT32	4 
#define TT_UINT32	5
#define TT_UINT8	6
#define TT_UCHAR	7

#define TF_IMMUTABLE	8 /* an immutable flag when used in array ptr */
#define TF_FUNCTION	(TF_IMMUTABLE+TT_BOOL) /* this combination is used to denote a method call */

#define CT_VM		0 /* call the virtual machine - function call (set frame) */
#define CT_VMJUMP	1 /* new PC value (useful for jump tables, args & values ignored) */
#define CT_DIRECT	2 /* call direct C function */

/* tagvalue size in bits. physical array size is always
 * aligned to 64 bits though
 */

#if 0
#define REALPTR(p) ((void *) (((unsigned long) (v_exec)) + ((long) ((p) & (~15)))))
#define shortptr_t int32_t
#else
#define REALPTR(p) ((void *)((p) & (~15)))
#define shortptr_t intptr_t
#endif

struct Tvalue_t;
struct Tframe_t;

typedef union {
	uint8_t u8;
	uint32_t u32; /* we deal here with bitops, too */
	int32_t i32;
	shortptr_t ptr; /* for pointer types */
	uint8_t b:1;
} Uvalue;

typedef struct {
	union {
		uint32_t callflags:2; /* call flags */
		uint32_t len; /* only if ->tt != TF_CALL */
		shortptr_t freelist; 
	};
	union {
		uint32_t flags:4; /* TT_* | TF_ addresses must be aligned to 16 bits */
		shortptr_t data; /* pointer to table if len */
		shortptr_t self;/* parent closure / bounding frame / class / "self" */
	};
} Tobject;

struct Tvalue_t	{
	uint32_t taghi:29; /* holds 0xffff */
	uint16_t tag:3; /* holds TT_ */
	Uvalue val;
};

typedef struct Tvalue_t Tvalue;
typedef struct Tframe_t Tframe;

struct	Tframe_t {
	Tobject otable; /* table referring to the following as tagvals start -> finfo */

	/* these are 32bit on i386, 64bit on amd64 */
	Tobject	*Freelist; /* freelist we belong to, externally represented as TT_OBJECT + TT_TAGGED */
	uint32_t *Opcodes; /* opcodes for this function */
	uint32_t *Savedip; /* saved ip of parent */
	Tframe *Parent; /* the actual parent frame */
	Tframe *Exception; /* exception handler, should not be ever entered twice. */
	unsigned long Nargs; /* number of args ve expect */
	Tvalue *A, *B, *C; /* frame context */

	/* public */
#define F_SELF 0
	Tvalue this; /* refers to self (points to otable above) */
#define F_BOUNDING 1
	Tvalue self; /* set by during the call, bounding frame */
#define F_ARG 2
	Tvalue arg; /* set during the call, the argument passed. */
//	Tvalue finfo;
#define F_GLOBAL 3
	Tvalue globals;
#define F_CONSTS 4
	Tvalue consts;
	Tvalue locals[]; /* locals */
};

#define OPCODE ((uint8_t*)pc)[0]
#define Ar ((uint8_t*)pc)[1]
#define Asr ((int8_t*)pc)[1]
#define Br ((uint8_t*)pc)[2]
#define Cr ((uint8_t*)pc)[3]
#define SKIPOP() { pc++; }
#define CONT() { SKIPOP(); goto continued; }

int	v_exec(Tframe *cframe)
{
	Tframe *frame = NULL;
	uint32_t *pc = NULL;

go_frame:
	//assert(!cframe->Parent); /* must NOT be in use */

	/* save parent */
	cframe->Savedip = pc;
	cframe->Parent = frame;

	/* and set active frame to 'cframe' */
	frame = cframe;

	/* reset ABC to locals */
	frame->A = frame->B = REALPTR(frame->otable.data);
	frame->C = REALPTR(frame->A[F_CONSTS].val.ptr); /* consts */


/* this is to be done by the allocator
	frame->self.taghi = 0xffff;
	frame->self.tag = TT_OBJECT;
	frame->self.val.o = &frame->otable;
	frame->a = frame->b = frame->c = frame->self; */
	pc = (void*) frame->Opcodes;

#define GETREG(name) Tvalue name##v = frame->name[name##r]
#define CHECKNUM(Xv) if (Xv.tag < TT_INT32) goto except;
	while (1) {
continued:;
		switch (OPCODE) {

/* OP_+{BAND,BOR,BXOR,BSHL,BSHR,ADD,SUB,MUL,DIV,MOD} = 11 math ops of OP_*(a,b,c) */

#define M(op,wtf) \
case OP_##op: { \
	GETREG(B); \
	GETREG(C); \
	CHECKNUM(Bv); \
	CHECKNUM(Cv); \
	frame->A[Ar] = Bv; \
	frame->A[Ar].val.u32 wtf##= Cv.val.u32; \
	CONT(); \
};

M(band,&);
M(bor,|);
M(bxor,^);
M(bshl,<<);
M(bshr,>>);
M(add,+);
M(sub,-);
M(mul,*);
M(div,/);
M(mod,%);

#undef M

/**************************************************
 * OP_lt: dst,b,c
 **************************************************/
case OP_lt: {
	GETREG(B);
	GETREG(C);
	CHECKNUM(Bv);
	CHECKNUM(Cv);
	if (Bv.val.u32 < Cv.val.u32)
		pc += Asr;
	CONT();
}

/**************************************************
 * OP_test: jmplong,c
 **************************************************/
case OP_test: {
	GETREG(C);
	if (Cv.val.u32)
		pc += *((int16_t *)(&Ar));
	CONT();
}

/**************************************************
 * OP_eq: jmp,b,c
 **************************************************/
case OP_eq: {
	asm("int3;");
	GETREG(B);
	GETREG(C);
	if (*(uint64_t *)&Bv == *(uint64_t *)&Cv)
		pc += Asr;
	CONT();
}

/**************************************************
 * OP_setabc: a,b,c
 **************************************************/
case OP_setabc: {
	int i;
	shortptr_t *f = REALPTR(frame->otable.data);
	for (i = 0; i < 3; i++) {
		int reg = ((int8_t*)pc)[1+i];
		if (reg>0) ((Tvalue **)&frame->A)[i] = REALPTR(f[reg]);
	}
/*	if (Ar!=255) { frame->A = REALPTR(f[Ar]); };
	if (Br!=255) { frame->B = REALPTR(f[Br]); };
	if (Cr!=255) { frame->C = REALPTR(f[Cr]); };*/
	CONT();
}

/**************************************************
 * OP_sett: val, tab, key
 **************************************************/
case OP_sett:{
	GETREG(B);
	if (Bv.tag != TT_OBJECT)
		goto except;
	Tobject *o = REALPTR(Bv.val.ptr);

	GETREG(C);
	/* must be indexing by integer value */
	if (Cv.tag < TT_UINT32)
		goto except;

	int idx = Cv.val.i32;
	unsigned len = o->len;
	/* negative index? */
	if (Cv.tag == TT_INT32 && idx < 0) {
		idx += len;
		if (idx < 0)
			goto except;
	}
	/* index must be valid */
	if (idx >= ((unsigned)len))
		goto except;
	GETREG(A);
	if (Av.tag != o->flags)
		goto except;
	void *p = REALPTR(o->data);
	if (Av.tag == TT_TAGGED) {
		((Tvalue *) p)[idx] = Av;
	} else {
		if (Av.tag >= TT_UINT8) {
			((uint8_t *)p)[idx] = Av.val.u8;
		} else if (Av.tag == TT_BOOL) {
			(((uint32_t *)p)[idx/32] |= (Av.val.b<<(idx%32)));
		} else { /* TT_UINT32 */
			((uint32_t *)p)[idx] = Av.val.u32;
		}
	}
	CONT();

}

/**************************************************
 * OP_gett: dst, tab, key
 **************************************************/
case OP_gett: {
	GETREG(B);
	if (Bv.tag != TT_OBJECT)
		goto except;

	Tobject *o = REALPTR(Bv.val.ptr);
	GETREG(C);

	if (o->flags == TF_FUNCTION) {
		/* actually doing a method call */
		Tobject *freelist = REALPTR(o->freelist);
		Tframe **frames = REALPTR(freelist->data);
//		assert(freelist->len>0);

		/* no frames available -> bail out to allocator (will restart the instruction later) */
		if (freelist->len == 1)
			goto except;

		/* ok, take one frame from the freelist */
		cframe = frames[--freelist->len];
		cframe->self.val.ptr = o->self & (~15); /* both are short pointers. make it TT_TAGGED */
		cframe->arg = Cv;
		cframe->globals = frames[0]->globals; /* reset globals ptr as env might have changed */
		SKIPOP(); /* will return to the next opcode */
		goto go_frame;
	}

	/* must be indexing by integer value */
	if (Cv.tag < TT_UINT32)
		goto except;

	int idx = Cv.val.i32;
	unsigned len = o->len;
	/* negative index? */
	if (Cv.tag == TT_INT32 && idx < 0) {
		idx += len;
		if (idx < 0)
			goto except;
	}
	/* index must be valid */
	if (idx >= ((unsigned)len))
		goto except;

	/* now, according the type width, copy the object */
	void *p = REALPTR(o->data);
	int tag = o->flags & 7;
	if (tag == TT_TAGGED) {
		frame->A[Ar] = ((Tvalue *) p)[idx];
	} else {
		Tvalue ret = { taghi: 0x1fffffff, tag: tag };
		if (tag >= TT_UINT8) {
			ret.val.u32 = ((uint8_t *)p)[idx];
		} else if (tag == TT_BOOL) {
			ret.val.u32 = (((uint32_t *)p)[idx/32] & (1<<(idx%32)));
		} else { /* TT_UINT32 */
			ret.val.u32 = ((uint32_t *)p)[idx];
		}
		frame->A[Ar] = ret;
	}
	CONT();



} // TT_GETT

} // switch

} // while
except:;
	cframe = frame->Exception;
		goto go_frame;

} // v_exec