ref: 6bc6badcb6768cd559431f139d13c7b9e5ef16ed
dir: /eval.c/
#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);
emitbyte(c, IPop);
}
}
static void
codegensub(Session *s, Module *m, ByteCode *c, Ast *a)
{
uvlong i;
switch(a->tag){
case AstProg:
for(i = 0; i < a->childcount; i++){
codegensub(s, m, c, a->children[i]);
emitbyte(c, IPop);
emitbyte(c, IDisplay);
}
break;
case AstFunc:
/* Emit bytecode for the function body */
{
Function *fn = alloc(DataFunction);
fn->ast = a;
if(fn->ast->funcleftarg){
fn->valence = Dyadic;
if(fn->ast->funcleftarg->optional)
fn->valence |= Monadic;
}else if(fn->ast->funcrightarg)
fn->valence = Monadic;
else
fn->valence = Niladic;
if(fn->ast->funcresult)
fn->hasresult = 1;
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, IPop);
}
if(fn->ast->funcresult)
codegensub(s, m, fn->code, fn->ast->funcresult);
emitbyte(fn->code, IReturn);
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 AstNiladic:
codegensub(s, m, c, a->func);
emitbyte(c, INiladic);
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:
error(EInternal, "Don't know how to do codegen for ast type %d", a->tag);
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)
error(EInternal, "popval on empty value stack");
s->count--; /* no realloc */
return s->values[s->count];
}
static void *
peekval(ValueStack *s)
{
if(s->count == 0)
error(EInternal, "peekval on empty value stack");
return s->values[s->count-1];
}
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)
error(EInternal, "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 int
nextinstr(CallStack *calls, ByteCode *c, uvlong o)
{
if(o < c->count && c->instrs[o] != IReturn)
return c->instrs[o];
if(calls->count == 0)
return -1;
else{
CallFrame f = calls->frames[calls->count-1];
return f.code->instrs[f.offset];
}
}
static void
checkarray(void *val)
{
if(val == nil || getalloctag(val) != DataArray)
error(EDomain, "non-array value where an array was expected");
}
static void *
evalbc(Session *s, Module *m, ByteCode *c)
{
ValueStack *values;
CallStack *calls;
ByteCode *newcode;
uvlong o, v;
Function *func;
void *r;
Array *x, *y, *z;
values = alloc(DataValueStack);
calls = alloc(DataCallStack);
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);
f->hasresult = 1;
pushval(values, f);
}
break;
case ILookup:
o += getuvlong(c->instrs+o, &v);
{
void *val = symval(m->symtab, v);
if(val == nil)
error(EValue, "%s is undefined", symname(m->symtab, v));
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++){
z = popval(values);
checkarray(z);
setarray(x, i, z);
}
x = simplifyarray(x);
pushval(values, x);
}
break;
case INiladic:
func = popval(values);
if(func->valence != Niladic){
int next = nextinstr(calls, c, o);
if(next == IAssign || IPop){
pushval(values, func);
break;
}else
error(ESyntax, "Function %s is not niladic", funcname(func));
}
if(func->code){
if(!func->hasresult){
if(nextinstr(calls, c, o) == IPop)
pushval(values, nil); /* fake result */
else
error(ESyntax, "Function %s does not produce a result", funcname(func));
}
pushcall(calls, func->code, &c, &o);
}else{
z = primnilad(func->prim);
pushval(values, z);
}
break;
case IMonadic:
/* FIXME: more duplicated code with INiladic and IDyadic than i would like */
func = popval(values);
y = popval(values);
if(!(func->valence & Monadic))
error(ESyntax, "Function %s is not monadic", funcname(func));
checkarray(y);
if(func->code){
if(!func->hasresult){
if(nextinstr(calls, c, o) == IPop)
pushval(values, nil); /* fake result */
else
error(ESyntax, "Function %s does not produce a result", funcname(func));
}
pushval(values, y);
if(func->valence & Dyadic) /* ambivalent function */
pushval(values, nil);
pushcall(calls, func->code, &c, &o);
}else{
z = primmonad(func->prim, y);
pushval(values, z);
}
break;
case IDyadic:
func = popval(values);
x = popval(values);
y = popval(values);
if(!(func->valence & Dyadic))
error(ESyntax, "Function %s is not dyadic", funcname(func));
checkarray(x);
checkarray(y);
if(func->code){
if(!func->hasresult){
if(nextinstr(calls, c, o) == IPop)
pushval(values, nil); /* fake result */
else
error(ESyntax, "Function %s does not produce a result", funcname(func));
}
pushval(values, y);
pushval(values, x);
pushcall(calls, func->code, &c, &o);
}else{
z = primdyad(func->prim, x, y);
pushval(values, z);
}
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 IReturn:
popcall(calls, m->symtab, &c, &o);
break;
case IAssign:
o += getuvlong(c->instrs+o, &v);
{
void *val = popval(values);
symset(m->symtab, v, val);
if(nextinstr(calls, c, o) == IPop)
val = nil;
pushval(values, val);
}
break;
case ILocal:
o += getuvlong(c->instrs+o, &v);
pushlocal(calls, m->symtab, v);
break;
case IPop:
r = popval(values);
if(nextinstr(calls, c, o) == IDisplay && r != nil)
appendlog(s, printval(r));
break;
case IDisplay:
/* nothing to do, IPop checks for it */
break;
default:
error(EInternal, "unknown instruction in evalbc: %d", instr);
}
}
r = nil;
if(values->count > 1)
error(EInternal, "Value stack size is %ulld", values->count);
if(calls->count > 0)
error(EInternal, "Call stack size is %ulld", calls->count);
if(values->count == 1)
r = popval(values);
return r;
}