#include #include #include #include #include #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 execute(Node *n) { Value *v; Lsym *sl; Node *l, *r; vlong i, s, e; Node res, xx; static int stmnt; gc(); 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 c; c = flt[0]; if(('a' <= c && c <= 'z') || ('A' <= c && c <= 'Z')) { r->type = TSTRING; r->fmt = 's'; r->string = strnode(flt); } else { r->type = TFLOAT; r->fval = atof(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); } }