ref: da6308e5df8ed9cdf8d8f6cad73eef10f31ac4b0
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);
}
}
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;
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++){
if(i != 0)
emitbyte(fn->code, IClear);
codegensub(s, m, fn->code, a->children[i]);
}
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 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);
if(a->func->tag == AstPrim)
emitbyte(c, IMonadic);
else
emitbyte(c, ICall);
break;
case AstDyadic:
codegensub(s, m, c, a->right);
codegensub(s, m, c, a->left);
codegensub(s, m, c, a->func);
if(a->func->tag == AstPrim)
emitbyte(c, IDyadic);
else
emitbyte(c, ICall);
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 *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);
}
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[s->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;
pushval(values, f);
}
break;
case ILookup:
o += getuvlong(c->instrs+o, &v);
pushval(values, symval(m->symtab, v)); /* TODO: value error? */
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:
appendlog(s, "NOTE: monadic call acts like ⊢\n");
break;
case IDyadic:
appendlog(s, "NOTE: dyadic call acts like ⊢\n");
popval(values);
break;
case ICall:
func = popval(values);
newcode = func->code;
call:
pushcall(calls, c, o);
c = newcode;
o = 0;
print("CALLED:\n");
debugbc(c);
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);
{
char *err;
TokenList *t = (TokenList *)v;
Ast *a = parse(t, m->symtab, &err);
if(!a){
appendlog(s, "RUNTIME PARSE: ");
appendlog(s, err);
appendlog(s, "\n");
return nil;
}else{
newcode = alloc(DataByteCode);
codegensub(s, m, newcode, a);
emitbyte(newcode, IReturn);
goto call;
}
}
break;
case IDone:
goto done;
break;
case IReturn:
popcall(calls, m->symtab, &c, &o);
print("RETURNED TO (%ulld)\n", o);
debugbc(c);
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;
}