#include <ctype.h>

#include <u.h>
#include <libc.h>
#include <bio.h>
#include <ctype.h>
#include <mach.h>
#define Extern extern
#include "acid.h"

void
error(char *fmt, ...)
{
int i;
char buf[2048];
va_list arg;

/* Unstack io channels */
if(iop != 0) {
for(i = 1; i < iop; i++)
Bterm(io[i]);
bout = io[0];
iop = 0;
}

ret = 0;
gotint = 0;
Bflush(bout);
if(silent)
silent = 0;
else {
va_start(arg, fmt);
vseprint(buf, buf+sizeof(buf), fmt, arg);
va_end(arg);
fprint(2, "%L: (error) %s\n", buf);
}
while(popio())
;
interactive = 1;
longjmp(err, 1);
}

void
unwind(void)
{
int i;
Lsym *s;
Value *v;

for(i = 0; i < Hashsize; i++) {
for(s = hash[i]; s; s = s->hash) {
while(s->v->pop) {
v = s->v->pop;
free(s->v);
s->v = v;
}
}
}
}

void
execrec(Node *n)
{
Value *v;
Lsym *s;

/* make node a root so it isn't collected! */
s = mkvar("_thiscmd");

v = gmalloc(sizeof(Value));
memset(v, 0, sizeof(Value));
v->type = TCODE;
v->cc = n;
v->pop = s->v;

s->v = v;
s->proc = n;

gc();
execute(n);

s->proc = s->v->cc;
s->v = v->pop;
free(v);
}

void
execute(Node *n)
{
Value *v;
Lsym *sl;
Node *l, *r;
vlong i, s, e;
Node res, xx;
static int stmnt;

if(gotint)
error("interrupted");

if(n == 0)
return;

if(stmnt++ > 5000) {
Bflush(bout);
stmnt = 0;
}

l = n->left;
r = n->right;

switch(n->op) {
default:
expr(n, &res);
if(ret || (res.type == TLIST && res.l == 0 && n->op != OADD))
break;
prnt->right = &res;
expr(prnt, &xx);
break;
case OASGN:
case OCALL:
expr(n, &res);
break;
case OCOMPLEX:
decl(n);
break;
case OLOCAL:
for(n = n->left; n; n = n->left) {
if(ret == 0)
error("local not in function");
sl = n->sym;
if(sl->v->ret == ret)
error("%s declared twice", sl->name);
v = gmalloc(sizeof(Value));
v->ret = ret;
v->pop = sl->v;
sl->v = v;
v->scope = 0;
*(ret->tail) = sl;
ret->tail = &v->scope;
v->set = 0;
}
break;
case ORET:
if(ret == 0)
error("return not in function");
expr(n->left, ret->val);
longjmp(ret->rlab, 1);
case OLIST:
execute(n->left);
execute(n->right);
break;
case OIF:
expr(l, &res);
if(r && r->op == OELSE) {
if(bool(&res))
execute(r->left);
else
execute(r->right);
}
else if(bool(&res))
execute(r);
break;
case OWHILE:
for(;;) {
expr(l, &res);
if(!bool(&res))
break;
execute(r);
}
break;
case ODO:
expr(l->left, &res);
if(res.type != TINT)
error("loop must have integer start");
s = res.ival;
expr(l->right, &res);
if(res.type != TINT)
error("loop must have integer end");
e = res.ival;
for(i = s; i <= e; i++)
execute(r);
break;
}
}

int
bool(Node *n)
{
int true = 0;

if(n->op != OCONST)
fatal("bool: not const");

switch(n->type) {
case TINT:
if(n->ival != 0)
true = 1;
break;
case TFLOAT:
if(n->fval != 0.0)
true = 1;
break;
case TSTRING:
if(n->string->len)
true = 1;
break;
case TLIST:
if(n->l)
true = 1;
break;
}
return true;
}

void
convflt(Node *r, char *flt)
{
char *s;

while(*flt == ' ')
flt++;

s = flt;
if(*s == '-' || *s == '+')
s++;
if(*s == '.')
s++;

if(*s >= '0' && *s <= '9'){
r->type = TFLOAT;
r->fval = atof(flt);
} else {
r->type = TSTRING;
r->fmt = 's';
r->string = strnode(flt);
}
}

void
indir(Map *m, uvlong addr, char fmt, Node *r)
{
int i;
ulong lval;
uvlong uvval;
int ret;
uchar cval;
ushort sval;
char buf[512], reg[12];

r->op = OCONST;
r->fmt = fmt;
switch(fmt) {
default:
error("bad pointer format '%c' for *", fmt);
case 'c':
case 'C':
case 'b':
r->type = TINT;
ret = get1(m, addr, &cval, 1);
if (ret < 0)
error("indir: %r");
r->ival = cval;
break;
case 'x':
case 'd':
case 'u':
case 'o':
case 'q':
case 'r':
r->type = TINT;
ret = get2(m, addr, &sval);
if (ret < 0)
error("indir: %r");
r->ival = sval;
break;
case 'a':
case 'A':
case 'W':
r->type = TINT;
ret = geta(m, addr, &uvval);
if (ret < 0)
error("indir: %r");
r->ival = uvval;
break;
case 'B':
case 'X':
case 'D':
case 'U':
case 'O':
case 'Q':
r->type = TINT;
ret = get4(m, addr, &lval);
if (ret < 0)
error("indir: %r");
r->ival = lval;
break;
case 'V':
case 'Y':
case 'Z':
r->type = TINT;
ret = get8(m, addr, &uvval);
if (ret < 0)
error("indir: %r");
r->ival = uvval;
break;
case 's':
r->type = TSTRING;
for(i = 0; i < sizeof(buf)-1; i++) {
ret = get1(m, addr, (uchar*)&buf[i], 1);
if (ret < 0)
error("indir: %r");
addr++;
if(buf[i] == '\0')
break;
}
buf[i] = 0;
if(i == 0)
strcpy(buf, "(null)");
r->string = strnode(buf);
break;
case 'R':
r->type = TSTRING;
for(i = 0; i < sizeof(buf)-2; i += 2) {
ret = get1(m, addr, (uchar*)&buf[i], 2);
if (ret < 0)
error("indir: %r");
addr += 2;
if(buf[i] == 0 && buf[i+1] == 0)
break;
}
buf[i++] = 0;
buf[i] = 0;
r->string = runenode((Rune*)buf);
break;
case 'i':
case 'I':
if ((*machdata->das)(m, addr, fmt, buf, sizeof(buf)) < 0)
error("indir: %r");
r->type = TSTRING;
r->fmt = 's';
r->string = strnode(buf);
break;
case 'f':
ret = get1(m, addr, (uchar*)buf, mach->szfloat);
if (ret < 0)
error("indir: %r");
machdata->sftos(buf, sizeof(buf), (void*) buf);
convflt(r, buf);
break;
case 'g':
ret = get1(m, addr, (uchar*)buf, mach->szfloat);
if (ret < 0)
error("indir: %r");
machdata->sftos(buf, sizeof(buf), (void*) buf);
r->type = TSTRING;
r->string = strnode(buf);
break;
case 'F':
ret = get1(m, addr, (uchar*)buf, mach->szdouble);
if (ret < 0)
error("indir: %r");
machdata->dftos(buf, sizeof(buf), (void*) buf);
convflt(r, buf);
break;
case '3': /* little endian ieee 80 with hole in bytes 8&9 */
ret = get1(m, addr, (uchar*)reg, 10);
if (ret < 0)
error("indir: %r");
memmove(reg+10, reg+8, 2); /* open hole */
memset(reg+8, 0, 2); /* fill it */
leieee80ftos(buf, sizeof(buf), reg);
convflt(r, buf);
break;
case '8': /* big-endian ieee 80 */
ret = get1(m, addr, (uchar*)reg, 10);
if (ret < 0)
error("indir: %r");
beieee80ftos(buf, sizeof(buf), reg);
convflt(r, buf);
break;
case 'G':
ret = get1(m, addr, (uchar*)buf, mach->szdouble);
if (ret < 0)
error("indir: %r");
machdata->dftos(buf, sizeof(buf), (void*) buf);
r->type = TSTRING;
r->string = strnode(buf);
break;
}
}

void
windir(Map *m, Node *addr, Node *rval, Node *r)
{
uchar cval;
ushort sval;
long lval;
Node res, aes;
int ret;

if(m == 0)
error("no map for */@=");

expr(rval, &res);
expr(addr, &aes);

if(aes.type != TINT)
error("bad type lhs of @/*");

if(m != cormap && wtflag == 0)
error("not in write mode");

r->type = res.type;
r->fmt = res.fmt;
r->Store = res.Store;

switch(res.fmt) {
default:
error("bad pointer format '%c' for */@=", res.fmt);
case 'c':
case 'C':
case 'b':
cval = res.ival;
ret = put1(m, aes.ival, &cval, 1);
break;
case 'r':
case 'x':
case 'd':
case 'u':
case 'o':
sval = res.ival;
ret = put2(m, aes.ival, sval);
r->ival = sval;
break;
case 'a':
case 'A':
case 'W':
ret = puta(m, aes.ival, res.ival);
break;
case 'B':
case 'X':
case 'D':
case 'U':
case 'O':
lval = res.ival;
ret = put4(m, aes.ival, lval);
break;
case 'V':
case 'Y':
case 'Z':
ret = put8(m, aes.ival, res.ival);
break;
case 's':
case 'R':
ret = put1(m, aes.ival, (uchar*)res.string->string, res.string->len);
break;
}
if (ret < 0)
error("windir: %r");
}

void
call(char *fn, Node *parameters, Node *local, Node *body, Node *retexp)
{
int np, i;
Rplace rlab;
Node *n, res;
Value *v, *f;
Lsym *s, *next;
Node *avp[Maxarg], *ava[Maxarg];

rlab.local = 0;

na = 0;
flatten(avp, parameters);
np = na;
na = 0;
flatten(ava, local);
if(np != na) {
if(np < na)
error("%s: too few arguments", fn);
error("%s: too many arguments", fn);
}

rlab.tail = &rlab.local;

ret = &rlab;
for(i = 0; i < np; i++) {
n = ava[i];
switch(n->op) {
default:
error("%s: %d formal not a name", fn, i);
case ONAME:
expr(avp[i], &res);
s = n->sym;
break;
case OINDM:
res.cc = avp[i];
res.type = TCODE;
res.comt = 0;
if(n->left->op != ONAME)
error("%s: %d formal not a name", fn, i);
s = n->left->sym;
break;
}
if(s->v->ret == ret)
error("%s already declared at this scope", s->name);

v = gmalloc(sizeof(Value));
v->ret = ret;
v->pop = s->v;
s->v = v;
v->scope = 0;
*(rlab.tail) = s;
rlab.tail = &v->scope;

v->Store = res.Store;
v->type = res.type;
v->set = 1;
}

ret->val = retexp;
if(setjmp(rlab.rlab) == 0)
execute(body);

for(s = rlab.local; s; s = next) {
f = s->v;
next = f->scope;
s->v = f->pop;
free(f);
}
}