shithub: lpa

ref: fe152caa60e1086c3f5b973e83135d04bde81fe1
dir: /eval.c/

View raw version
#include <u.h>
#include <libc.h>
#include <thread.h>

#include "dat.h"
#include "fns.h"

static ByteCode *codegen(Session *, Module *, Ast *);
static void *evalbc(Session *, Module *, ByteCode *);

void *
eval(Session *s, Ast *a)
{
	/* Evaluate some ast in module m in session s. */
	Module *m = s->modules->modules[0]; /* TODO: this isn't nice */
	ByteCode *code = codegen(s, m, a);
	return evalbc(s, m, code);
}

static void
emitbyte(ByteCode *c, u8int i)
{
	c->count += 1;
	c->instrs = allocextra(c, c->count);
	c->instrs[c->count-1] = i;
}

static void
emituvlong(ByteCode *c, uvlong v)
{
	for(int i = 0; i < sizeof(v); i++)
		emitbyte(c, (v>>(8*i)) & 0xFF);
}

static void
emitptr(ByteCode *c, void *p)
{
	emituvlong(c, (uvlong)p);
}

static void
emitlocal(ByteCode *c, Symtab *s, Ast *a, int assign)
{
	if(a == nil)
		return;

	uvlong id = sym(s, a->name);
	emitbyte(c, ILocal);
	emituvlong(c, id);
	if(assign){
		emitbyte(c, IAssign);
		emituvlong(c, id);
	}
}

static void
codegensub(Session *s, Module *m, ByteCode *c, Ast *a)
{
	char *err;
	uvlong i;

	switch(a->tag){
	case AstProg:
		for(i = 0; i < a->childcount; i++){
			if(i != 0)
				emitbyte(c, IClear);
			codegensub(s, m, c, a->children[i]);
		}
		emitbyte(c, IDone);
		break;
	case AstFunc:
		/* Emit bytecode for the function body */
		{
			Function *fn = alloc(DataFunction);
			fn->ast = a;
			if(fn->ast->funcleftarg)
				fn->valence = Dyadic;
			else if(fn->ast->funcrightarg)
				fn->valence = Monadic;

			fn->symbol = sym(m->symtab, a->funcname->name);
			fn->code = alloc(DataByteCode);
			emitbyte(fn->code, IPushConst);
			emitptr(fn->code, fn);
			emitlocal(fn->code, m->symtab, fn->ast->funcname, 1);
			emitlocal(fn->code, m->symtab, fn->ast->funcresult, 0);
			emitlocal(fn->code, m->symtab, fn->ast->funcleftarg, 1);
			emitlocal(fn->code, m->symtab, fn->ast->funcrightarg, 1);
			for(i = 0; i < fn->ast->funclocals->childcount; i++)
				emitlocal(fn->code, m->symtab, fn->ast->funclocals->children[i], 0);
			for(i = 0; i < a->childcount; i++){
				codegensub(s, m, fn->code, a->children[i]);
				emitbyte(fn->code, IClear);
			}
			if(fn->ast->funcresult)
				codegensub(s, m, fn->code, fn->ast->funcresult);
			emitbyte(fn->code, IReturn);

			emitbyte(c, IPushConst);
			emitptr(c, fn);

			/* push the value twice so defining a function yields a function value.. */
			emitbyte(c, IPushConst);
			emitptr(c, fn);

			emitbyte(c, IAssign);
			emituvlong(c, fn->symbol);
		}
		break;
	case AstName:
		emitbyte(c, ILookup);
		emituvlong(c, sym(m->symtab, a->name));
		break;
	case AstAssign:
		codegensub(s, m, c, a->right);
		emitbyte(c, IAssign);
		emituvlong(c, sym(m->symtab, a->left->name));
		break;
	case AstConst:
		emitbyte(c, IPushConst);
		emitptr(c, a->val); /* TODO: better to have consts array and emit index? */
		break;
	case AstStrand:
		/* right to left */
		for(i = a->childcount; i > 0; i--)
			codegensub(s, m, c, a->children[i-1]);
		emitbyte(c, IStrand);
		emituvlong(c, a->childcount);
		break;
	case AstMonadic:
		codegensub(s, m, c, a->right);
		codegensub(s, m, c, a->func);
		emitbyte(c, IMonadic);
		break;
	case AstDyadic:
		codegensub(s, m, c, a->right);
		codegensub(s, m, c, a->left);
		codegensub(s, m, c, a->func);
		emitbyte(c, IDyadic);
		break;
	case AstPrim:
		emitbyte(c, IPushPrim);
		emituvlong(c, a->prim); /* TODO: waste of space */
		break;
	case AstLater:
		emitbyte(c, IParse);
		emitptr(c, a->tokens);
		break;
	default:
		err = smprint("Don't know how to do codegen for ast type %d\n", a->tag);
		appendlog(s, err);
		free(err);
		break;
	}

}

static ByteCode *
codegen(Session *s, Module *m, Ast *a)
{
	ByteCode *c = alloc(DataByteCode);
	codegensub(s, m, c, a);
	return c;
}

static void
pushval(ValueStack *s, void *v)
{
	s->count++;
	s->values = allocextra(s, s->count * sizeof(v));
	s->values[s->count-1] = v;
}

static void *
popval(ValueStack *s)
{
	if(s->count == 0)
		sysfatal("popval on empty value stack");
	s->count--; /* no realloc */
	return s->values[s->count];
}

static void
pushcall(CallStack *s, ByteCode *newcode, ByteCode **c, uvlong *o)
{
	s->count++;
	s->frames = allocextra(s, s->count * sizeof(CallFrame));
	s->frames[s->count-1].code = *c;
	s->frames[s->count-1].offset = *o;
	s->frames[s->count-1].locals = alloc(DataLocalList);

	*c = newcode;
	*o = 0;
}

static void
popcall(CallStack *s, Symtab *t, ByteCode **c, uvlong *o)
{
	if(s->count == 0)
		sysfatal("popcall on empty call stack");
	s->count--; /* no realloc */
	*c = s->frames[s->count].code;
	*o = s->frames[s->count].offset;

	LocalList *locals = s->frames[s->count].locals;
	for(uvlong i = 0; i < locals->count; i++)
		symset(t, locals->list[i].id, locals->list[i].value);
}

static void
pushlocal(CallStack *c, Symtab *s, uvlong id)
{
	CallFrame f = c->frames[c->count-1];

	f.locals->count++;
	f.locals->list = allocextra(f.locals, sizeof(Local) * f.locals->count);
	f.locals->list[f.locals->count-1].id = id;
	f.locals->list[f.locals->count-1].value = symval(s, id);

	symset(s, id, nil);
}

static void *
evalbc(Session *s, Module *m, ByteCode *c)
{
	ValueStack *values;
	CallStack *calls;

	ByteCode *newcode;
	uvlong o, v;
	Function *func;
	void *r;

	values = alloc(DataValueStack);
	calls = alloc(DataCallStack);

	debugbc(c);

	o = 0;
	while(o < c->count){
		int instr = c->instrs[o];
		o++;

		switch(instr){
		case IPushConst:
			o += getuvlong(c->instrs+o, &v);
			pushval(values, (void*)v);
			break;
		case IPushPrim:
			o += getuvlong(c->instrs+o, &v);
			{
				Function *f = alloc(DataFunction);
				f->prim = v;
				f->valence = primvalence(v);
				pushval(values, f);
			}
			break;
		case ILookup:
			o += getuvlong(c->instrs+o, &v);
			{
				void *val = symval(m->symtab, v);
				if(val == nil){
					appendlog(s, "VALUE ERROR\n");
					return nil;
				}
				pushval(values, val);
			}
			break;
		case IStrand:
			o += getuvlong(c->instrs+o, &v);
			{
				Array *x = allocarray(TypeArray, 1, v);
				setshape(x, 0, v);
				for(uvlong i = 0; i < v; i++)
					setarray(x, i, popval(values));
				x = simplifyarray(x);
				pushval(values, x);
			}
			break;
		case IMonadic:
			func = popval(values);
			if(!(func->valence & Monadic)){
				appendlog(s, "ERROR: Function not monadic!\n");
				return nil;
			}

			if(func->code)
				pushcall(calls, func->code, &c, &o);
			else{
				Array *y = popval(values);
				Array *z = primmonad(func->prim, y);
				pushval(values, z);
			}
			break;
		case IDyadic:
			func = popval(values);
			if(!(func->valence & Dyadic)){
				appendlog(s, "ERROR: Function not dyadic!\n");
				return nil;
			}

			if(func->code)
				pushcall(calls, func->code, &c, &o);
			else{
				Array *x = popval(values);
				Array *y = popval(values);
				Array *z = primdyad(func->prim, x, y);
				pushval(values, z);
			}
			break;
		case IClear: /* TODO: get rid of this instruction. It shouldn't be there, and it is wrong */
			while(values->count > 0)
				popval(values);
			break;
		case IParse:
			/* parse at runtime and emit code */
			o += getuvlong(c->instrs+o, &v);
			{
				TokenList *t = (TokenList *)v;
				Ast *a = parse(t, m->symtab);
				newcode = alloc(DataByteCode);
				codegensub(s, m, newcode, a);
				emitbyte(newcode, IReturn);
				pushcall(calls, newcode, &c, &o);
			}
			break;
		case IDone:
			goto done;
			break;
		case IReturn:
			popcall(calls, m->symtab, &c, &o);
			break;
		case IAssign:
			o += getuvlong(c->instrs+o, &v);
			symset(m->symtab, v, popval(values));
			break;
		case ILocal:
			o += getuvlong(c->instrs+o, &v);
			pushlocal(calls, m->symtab, v);
			break;
		default:
			appendlog(s, "unknown instruction in evalbc\n");
			return nil;
		}
	}

done:
	r = nil;
	print("Final value stack size: %ulld\n", values->count);
	print("Final call stack size: %ulld\n", calls->count);
	if(values->count != 0)
		r = popval(values);
	return r;
}