#include #include "isa.h" #include "interp.h" #include "raise.h" #include "pool.h" REG R; /* Virtual Machine registers */ String snil; /* String known to be zero length */ #define OP(fn) void fn(void) #define B(r) *((BYTE*)(R.r)) #define W(r) *((WORD*)(R.r)) #define UW(r) *((UWORD*)(R.r)) #define F(r) *((REAL*)(R.r)) #define V(r) *((LONG*)(R.r)) #define UV(r) *((ULONG*)(R.r)) #define S(r) *((String**)(R.r)) #define A(r) *((Array**)(R.r)) #define L(r) *((List**)(R.r)) #define P(r) *((WORD**)(R.r)) #define C(r) *((Channel**)(R.r)) #define T(r) *((void**)(R.r)) #define JMP(r) R.PC = *(Inst**)(R.r) #define SH(r) *((SHORT*)(R.r)) #define SR(r) *((SREAL*)(R.r)) OP(runt) {} OP(negf) { F(d) = -F(s); } OP(jmp) { JMP(d); } OP(movpc){ T(d) = &R.M->prog[W(s)]; } OP(movm) { memmove(R.d, R.s, W(m)); } OP(lea) { W(d) = (WORD)R.s; } OP(movb) { B(d) = B(s); } OP(movw) { W(d) = W(s); } OP(movf) { F(d) = F(s); } OP(movl) { V(d) = V(s); } OP(cvtbw){ W(d) = B(s); } OP(cvtwb){ B(d) = W(s); } OP(cvtrf){ F(d) = SR(s); } OP(cvtfr){ SR(d) = F(s); } OP(cvtws){ SH(d) = W(s); } OP(cvtsw){ W(d) = SH(s); } OP(cvtwf){ F(d) = W(s); } OP(addb) { B(d) = B(m) + B(s); } OP(addw) { W(d) = W(m) + W(s); } OP(addl) { V(d) = V(m) + V(s); } OP(addf) { F(d) = F(m) + F(s); } OP(subb) { B(d) = B(m) - B(s); } OP(subw) { W(d) = W(m) - W(s); } OP(subl) { V(d) = V(m) - V(s); } OP(subf) { F(d) = F(m) - F(s); } OP(divb) { B(d) = B(m) / B(s); } OP(divw) { W(d) = W(m) / W(s); } OP(divl) { V(d) = V(m) / V(s); } OP(divf) { F(d) = F(m) / F(s); } OP(modb) { B(d) = B(m) % B(s); } OP(modw) { W(d) = W(m) % W(s); } OP(modl) { V(d) = V(m) % V(s); } OP(mulb) { B(d) = B(m) * B(s); } OP(mulw) { W(d) = W(m) * W(s); } OP(mull) { V(d) = V(m) * V(s); } OP(mulf) { F(d) = F(m) * F(s); } OP(andb) { B(d) = B(m) & B(s); } OP(andw) { W(d) = W(m) & W(s); } OP(andl) { V(d) = V(m) & V(s); } OP(xorb) { B(d) = B(m) ^ B(s); } OP(xorw) { W(d) = W(m) ^ W(s); } OP(xorl) { V(d) = V(m) ^ V(s); } OP(orb) { B(d) = B(m) | B(s); } OP(orw) { W(d) = W(m) | W(s); } OP(orl) { V(d) = V(m) | V(s); } OP(shlb) { B(d) = B(m) << W(s); } OP(shlw) { W(d) = W(m) << W(s); } OP(shll) { V(d) = V(m) << W(s); } OP(shrb) { B(d) = B(m) >> W(s); } OP(shrw) { W(d) = W(m) >> W(s); } OP(shrl) { V(d) = V(m) >> W(s); } OP(lsrw) { W(d) = UW(m) >> W(s); } OP(lsrl) { V(d) = UV(m) >> W(s); } OP(beqb) { if(B(s) == B(m)) JMP(d); } OP(bneb) { if(B(s) != B(m)) JMP(d); } OP(bltb) { if(B(s) < B(m)) JMP(d); } OP(bleb) { if(B(s) <= B(m)) JMP(d); } OP(bgtb) { if(B(s) > B(m)) JMP(d); } OP(bgeb) { if(B(s) >= B(m)) JMP(d); } OP(beqw) { if(W(s) == W(m)) JMP(d); } OP(bnew) { if(W(s) != W(m)) JMP(d); } OP(bltw) { if(W(s) < W(m)) JMP(d); } OP(blew) { if(W(s) <= W(m)) JMP(d); } OP(bgtw) { if(W(s) > W(m)) JMP(d); } OP(bgew) { if(W(s) >= W(m)) JMP(d); } OP(beql) { if(V(s) == V(m)) JMP(d); } OP(bnel) { if(V(s) != V(m)) JMP(d); } OP(bltl) { if(V(s) < V(m)) JMP(d); } OP(blel) { if(V(s) <= V(m)) JMP(d); } OP(bgtl) { if(V(s) > V(m)) JMP(d); } OP(bgel) { if(V(s) >= V(m)) JMP(d); } OP(beqf) { if(F(s) == F(m)) JMP(d); } OP(bnef) { if(F(s) != F(m)) JMP(d); } OP(bltf) { if(F(s) < F(m)) JMP(d); } OP(blef) { if(F(s) <= F(m)) JMP(d); } OP(bgtf) { if(F(s) > F(m)) JMP(d); } OP(bgef) { if(F(s) >= F(m)) JMP(d); } OP(beqc) { if(stringcmp(S(s), S(m)) == 0) JMP(d); } OP(bnec) { if(stringcmp(S(s), S(m)) != 0) JMP(d); } OP(bltc) { if(stringcmp(S(s), S(m)) < 0) JMP(d); } OP(blec) { if(stringcmp(S(s), S(m)) <= 0) JMP(d); } OP(bgtc) { if(stringcmp(S(s), S(m)) > 0) JMP(d); } OP(bgec) { if(stringcmp(S(s), S(m)) >= 0) JMP(d); } OP(iexit){ error(""); } OP(cvtwl){ V(d) = W(s); } OP(cvtlw){ W(d) = V(s); } OP(cvtlf){ F(d) = V(s); } OP(cvtfl) { REAL f; f = F(s); V(d) = f < 0 ? f - .5 : f + .5; } OP(cvtfw) { REAL f; f = F(s); W(d) = f < 0 ? f - .5 : f + .5; } OP(cvtcl) { String *s; s = S(s); if(s == H) V(d) = 0; else V(d) = strtoll(string2c(s), nil, 10); } OP(indx) { ulong i; Array *a; a = A(s); i = W(d); if(a == H || i >= a->len) error(exBounds); W(m) = (WORD)(a->data+i*a->t->size); } OP(indw) { ulong i; Array *a; a = A(s); i = W(d); if(a == H || i >= a->len) error(exBounds); W(m) = (WORD)(a->data+i*sizeof(WORD)); } OP(indf) { ulong i; Array *a; a = A(s); i = W(d); if(a == H || i >= a->len) error(exBounds); W(m) = (WORD)(a->data+i*sizeof(REAL)); } OP(indl) { ulong i; Array *a; a = A(s); i = W(d); if(a == H || i >= a->len) error(exBounds); W(m) = (WORD)(a->data+i*sizeof(LONG)); } OP(indb) { ulong i; Array *a; a = A(s); i = W(d); if(a == H || i >= a->len) error(exBounds); W(m) = (WORD)(a->data+i*sizeof(BYTE)); } OP(movp) { Heap *h; WORD *dv, *sv; sv = P(s); if(sv != H) { h = D2H(sv); h->ref++; Setmark(h); } dv = P(d); P(d) = sv; destroy(dv); } OP(movmp) { Type *t; t = R.M->type[W(m)]; incmem(R.s, t); if (t->np) freeptrs(R.d, t); memmove(R.d, R.s, t->size); } OP(new) { Heap *h; WORD **wp, *t; h = heap(R.M->type[W(s)]); wp = R.d; t = *wp; *wp = H2D(WORD*, h); destroy(t); } OP(newz) { Heap *h; WORD **wp, *t; h = heapz(R.M->type[W(s)]); wp = R.d; t = *wp; *wp = H2D(WORD*, h); destroy(t); } OP(mnewz) { Heap *h; WORD **wp, *t; Modlink *ml; ml = *(Modlink**)R.s; if(ml == H) error(exModule); h = heapz(ml->type[W(m)]); wp = R.d; t = *wp; *wp = H2D(WORD*, h); destroy(t); } OP(frame) { Type *t; Frame *f; uchar *nsp; t = R.M->type[W(s)]; nsp = R.SP + t->size; if(nsp >= R.TS) { R.s = t; extend(); T(d) = R.s; return; } f = (Frame*)R.SP; R.SP = nsp; f->t = t; f->mr = nil; if (t->np) initmem(t, f); T(d) = f; } OP(mframe) { Type *t; Frame *f; uchar *nsp; Modlink *ml; ml = *(Modlink**)R.s; if(ml == H) error(exModule); t = ml->links[W(m)].frame; nsp = R.SP + t->size; if(nsp >= R.TS) { R.s = t; extend(); T(d) = R.s; return; } f = (Frame*)R.SP; R.SP = nsp; f->t = t; f->mr = nil; if (t->np) initmem(t, f); T(d) = f; } void acheck(int tsz, int sz) { if(sz < 0) error(exNegsize); /* test for overflow; assumes sz >>> tsz */ if((int)(sizeof(Array) + sizeof(Heap) + tsz*sz) < sz) error(exHeap); } OP(newa) { int sz; Type *t; Heap *h; Array *a, *at, **ap; t = R.M->type[W(m)]; sz = W(s); acheck(t->size, sz); h = nheap(sizeof(Array) + (t->size*sz)); h->t = &Tarray; Tarray.ref++; a = H2D(Array*, h); a->t = t; a->len = sz; a->root = H; a->data = (uchar*)a + sizeof(Array); initarray(t, a); ap = R.d; at = *ap; *ap = a; destroy(at); } OP(newaz) { int sz; Type *t; Heap *h; Array *a, *at, **ap; t = R.M->type[W(m)]; sz = W(s); acheck(t->size, sz); h = nheap(sizeof(Array) + (t->size*sz)); h->t = &Tarray; Tarray.ref++; a = H2D(Array*, h); a->t = t; a->len = sz; a->root = H; a->data = (uchar*)a + sizeof(Array); memset(a->data, 0, t->size*sz); initarray(t, a); ap = R.d; at = *ap; *ap = a; destroy(at); } Channel* cnewc(void (*mover)(void)) { Heap *h; Channel *c; h = heap(&Tchannel); c = H2D(Channel*, h); c->send = nil; c->sendalt = nil; c->recv = nil; c->recvalt = nil; c->mover = mover; return c; } Channel* newc(void (*mover)(void)) { Channel **cp, *oldc; cp = R.d; oldc = *cp; *cp = cnewc(mover); destroy(oldc); return *cp; } OP(newcl) { newc(movl); } OP(newcb) { newc(movb); } OP(newcw) { newc(movw); } OP(newcf) { newc(movf); } OP(newcp) { newc(movp); } OP(newcm) { Channel *c; c = newc(movm); c->mid.w = W(s); } OP(newcmp) { Channel *c; c = newc(movtmp); c->mid.t = R.M->type[W(s)]; c->mid.t->ref++; } OP(icase) { WORD v, *t, *l, d, n, n2; v = W(s); t = (WORD*)((WORD)R.d + IBY2WD); n = t[-1]; d = t[n*3]; while(n > 0) { n2 = n >> 1; l = t + n2*3; if(v < l[0]) { n = n2; continue; } if(v >= l[1]) { t = l+3; n -= n2 + 1; continue; } d = l[2]; break; } if(R.M->compiled) { R.PC = (Inst*)d; return; } R.PC = R.M->prog + d; } OP(casec) { WORD *t, *e; String *sl, *sh, *sv; sv = S(s); t = (WORD*)((WORD)R.d + IBY2WD); e = t + t[-1] * 3; while(t < e) { sl = (String*)t[0]; sh = (String*)t[1]; if(sh == H) { if(stringcmp(sl, sv) == 0) { t = &t[2]; goto found; } } else if(stringcmp(sl, sv) <= 0 && stringcmp(sh, sv) >= 0) { t = &t[2]; goto found; } t += 3; } found: if(R.M->compiled) { R.PC = (Inst*)*t; return; } R.PC = R.M->prog + t[0]; } OP(igoto) { WORD *t; t = (WORD*)((WORD)R.d + (W(s) * IBY2WD)); if(R.M->compiled) { R.PC = (Inst*)t[0]; return; } R.PC = R.M->prog + t[0]; } OP(call) { Frame *f; f = T(s); f->lr = R.PC; f->fp = R.FP; R.FP = (uchar*)f; JMP(d); } OP(spawn) { Prog *p; p = newprog(currun(), R.M); p->R.PC = *(Inst**)R.d; newstack(p); unframe(); } OP(mspawn) { Prog *p; Modlink *ml; ml = *(Modlink**)R.d; if(ml == H) error(exModule); if(ml->prog == nil) error(exSpawn); p = newprog(currun(), ml); p->R.PC = ml->links[W(m)].u.pc; newstack(p); unframe(); } OP(ret) { Frame *f; Modlink *m; f = (Frame*)R.FP; R.FP = f->fp; if(R.FP == nil) { R.FP = (uchar*)f; error(""); } R.SP = (uchar*)f; R.PC = f->lr; m = f->mr; if(f->t == nil) unextend(f); else if (f->t->np) freeptrs(f, f->t); if(m != nil) { if(R.M->compiled != m->compiled) { R.IC = 1; R.t = 1; } destroy(R.M); R.M = m; R.MP = m->MP; } } OP(iload) { char *n; Module *m; Modlink *ml, **mp, *t; n = string2c(S(s)); if(strcmp(n, "$self") == 0) { m = R.M->m; m->ref++; ml = linkmod(m, T(m), 0); ml->MP = R.M->MP; D2H(ml->MP)->ref++; } else { m = readmod(n, lookmod(n), 1); ml = linkmod(m, T(m), 1); } mp = R.d; t = *mp; *mp = ml; destroy(t); } OP(mcall) { Heap *h; Prog *p; Frame *f; Linkpc *l; Modlink *ml; ml = *(Modlink**)R.d; if(ml == H) error(exModule); f = T(s); f->lr = R.PC; f->fp = R.FP; f->mr = R.M; R.FP = (uchar*)f; R.M = ml; h = D2H(ml); h->ref++; l = &ml->links[W(m)].u; if(ml->prog == nil) { l->runt(f); h->ref--; R.M = f->mr; R.SP = R.FP; R.FP = f->fp; if(f->t == nil) unextend(f); else if (f->t->np) freeptrs(f, f->t); p = currun(); if(p->kill != nil) error(p->kill); R.t = 0; return; } R.MP = R.M->MP; R.PC = l->pc; R.t = 1; if(f->mr->compiled != R.M->compiled) R.IC = 1; } OP(lena) { WORD l; Array *a; a = A(s); l = 0; if(a != H) l = a->len; W(d) = l; } OP(lenl) { WORD l; List *a; a = L(s); l = 0; while(a != H) { l++; a = a->tail; } W(d) = l; } OP(isend) { Channel *c; Prog *p, *f; c = C(d); if(c == H) error(exNilref); if(c->recv == nil && c->recvalt == nil) { p = delrun(Psend); p->ptr = R.s; p->chan = c; /* for killprog */ R.IC = 1; R.t = 1; p->comm = nil; if(c->send == nil) c->send = p; else { for(f = c->send; f->comm; f = f->comm) ; f->comm = p; } return; } if(c->recvalt != nil) { p = c->recvalt; c->recvalt = nil; altdone(p->R.s, p, c, 1); } else { p = c->recv; c->recv = p->comm; } R.m = &c->mid; R.d = p->ptr; p->ptr = nil; c->mover(); addrun(p); R.t = 0; } OP(irecv) { Channel *c; Prog *p, *f; List *sq, *sqt; c = C(s); if(c == H) error(exNilref); if(c->send == nil && c->sendalt == nil) { if (c->sendq != H) { sq = c->sendq; sqt = sq->tail; c->sendq = sqt; if (sqt != H) { Setmark(D2H(sqt)); sq->tail = H; } R.m = &c->mid; R.s = sq->data; c->mover(); R.t = 0; destroy(sq); return; } p = delrun(Precv); p->ptr = R.d; p->chan = c; /* for killprog */ R.IC = 1; R.t = 1; p->comm = nil; if(c->recv == nil) c->recv = p; else { for(f = c->recv; f->comm; f = f->comm) ; f->comm = p; } return; } if(c->sendalt != nil) { p = c->sendalt; c->sendalt = nil; altdone(p->R.s, p, c, 0); } else { p = c->send; c->send = p->comm; } R.m = &c->mid; R.s = p->ptr; p->ptr = nil; c->mover(); addrun(p); R.t = 0; } int csendq(Channel *c, void *ip, Type *t, int lim) { List *l, **lp; REG rsav; int len; if(c == H) error(exNilref); if(c->recv == nil && c->recvalt == nil) { len = 0; for (lp = &c->sendq; len != lim && (l = *lp) != H; lp = &l->tail) len++; if (len == lim) { if (t->np) freeptrs(ip, t); return 0; } l = cons(t->size, lp); memmove(l->data, ip, t->size); l->t = t; t->ref++; return 1; } rsav = R; R.s = ip; R.d = &c; isend(); R = rsav; if (t->np) freeptrs(ip, t); return 1; } List* cons(ulong size, List **lp) { Heap *h; List *lv, *l; h = nheap(sizeof(List) + size); h->t = &Tlist; Tlist.ref++; l = H2D(List*, h); l->t = nil; lv = *lp; if(lv != H) { h = D2H(lv); Setmark(h); } l->tail = lv; *lp = l; return l; } OP(consb) { List *l; l = cons(IBY2WD, R.d); *(BYTE*)l->data = B(s); } OP(consw) { List *l; l = cons(IBY2WD, R.d); *(WORD*)l->data = W(s); } OP(consl) { List *l; l = cons(IBY2LG, R.d); *(LONG*)l->data = V(s); } OP(consp) { List *l; Heap *h; WORD *sv; l = cons(IBY2WD, R.d); sv = P(s); if(sv != H) { h = D2H(sv); h->ref++; Setmark(h); } l->t = &Tptr; Tptr.ref++; *(WORD**)l->data = sv; } OP(consf) { List *l; l = cons(sizeof(REAL), R.d); *(REAL*)l->data = F(s); } OP(consm) { int v; List *l; v = W(m); l = cons(v, R.d); memmove(l->data, R.s, v); } OP(consmp) { List *l; Type *t; t = R.M->type[W(m)]; l = cons(t->size, R.d); incmem(R.s, t); memmove(l->data, R.s, t->size); l->t = t; t->ref++; } OP(headb) { List *l; l = L(s); B(d) = *(BYTE*)l->data; } OP(headw) { List *l; l = L(s); W(d) = *(WORD*)l->data; } OP(headl) { List *l; l = L(s); V(d) = *(LONG*)l->data; } OP(headp) { List *l; l = L(s); R.s = l->data; movp(); } OP(headf) { List *l; l = L(s); F(d) = *(REAL*)l->data; } OP(headm) { List *l; l = L(s); memmove(R.d, l->data, W(m)); } OP(headmp) { List *l; l = L(s); R.s = l->data; movmp(); } OP(tail) { List *l; l = L(s); R.s = &l->tail; movp(); } OP(slicea) { Type *t; Heap *h; Array *at, *ss, *ds; int v, n, start; v = W(m); start = W(s); n = v - start; ds = A(d); if(ds == H) { if(n == 0) return; error(exNilref); } if(n < 0 || (ulong)start > ds->len || (ulong)v > ds->len) error(exBounds); t = ds->t; h = heap(&Tarray); ss = H2D(Array*, h); ss->len = n; ss->data = ds->data + start*t->size; ss->t = t; t->ref++; if(ds->root != H) { /* slicing a slice */ ds = ds->root; h = D2H(ds); h->ref++; at = A(d); A(d) = ss; ss->root = ds; destroy(at); } else { h = D2H(ds); ss->root = ds; A(d) = ss; } Setmark(h); } OP(slicela) { Type *t; int l, dl; Array *ss, *ds; uchar *sp, *dp, *ep; ss = A(s); dl = W(m); ds = A(d); if(ss == H) return; if(ds == H) error(exNilref); if(dl+ss->len > ds->len) error(exBounds); t = ds->t; if(t->np == 0) { memmove(ds->data+dl*t->size, ss->data, ss->len*t->size); return; } sp = ss->data; dp = ds->data+dl*t->size; if(dp > sp) { l = ss->len * t->size; sp = ss->data + l; ep = dp + l; while(ep > dp) { ep -= t->size; sp -= t->size; incmem(sp, t); if (t->np) freeptrs(ep, t); } } else { ep = dp + ss->len*t->size; while(dp < ep) { incmem(sp, t); if (t->np) freeptrs(dp, t); dp += t->size; sp += t->size; } } memmove(ds->data+dl*t->size, ss->data, ss->len*t->size); } OP(alt) { R.t = 0; xecalt(1); } OP(nbalt) { xecalt(0); } OP(tcmp) { void *s, *d; s = T(s); d = T(d); if(s != H && (d == H || D2H(s)->t != D2H(d)->t)) error(exTcheck); } OP(eclr) { R.PC = unlinkex(); } OP(badop) { error(exOp); } void destroystack(REG *reg) { Type *t; Frame *f, *fp; Modlink *m; Stkext *sx; uchar *ex; ex = reg->EX; reg->EX = nil; while(ex != nil) { sx = (Stkext*)ex; fp = sx->reg.tos.fr; do { f = (Frame*)reg->FP; reg->FP = f->fp; t = f->t; if(t == nil) t = sx->reg.TR; m = f->mr; if (t->np) freeptrs(f, t); if(m != nil) { destroy(reg->M); reg->M = m; } } while(f != fp); ex = sx->reg.EX; free(sx); } destroy(reg->M); } Prog* isave(void) { Prog *p; p = delrun(Prelease); p->R = R; return p; } void irestore(Prog *p) { R = p->R; R.IC = 1; } void movtmp(void) /* Used by send & receive */ { Type *t; t = (Type*)W(m); incmem(R.s, t); if (t->np) freeptrs(R.d, t); memmove(R.d, R.s, t->size); } extern OP(cvtca); extern OP(cvtac); extern OP(cvtwc); extern OP(cvtcw); extern OP(cvtfc); extern OP(cvtcf); extern OP(insc); extern OP(indc); extern OP(addc); extern OP(lenc); extern OP(slicec); extern OP(cvtlc); #include "optab.h" void opinit(void) { int i; for(i = 0; i < 256; i++) if(optab[i] == nil) optab[i] = badop; } void xec(Prog *p) { int op; R = p->R; R.MP = R.M->MP; R.IC = p->quanta; if(p->kill != nil) { char *m; m = p->kill; p->kill = nil; error(m); } if(R.M->compiled) comvec(); else do { dec[R.PC->add](); op = R.PC->op; R.PC++; optab[op](); } while(--R.IC != 0); p->R = R; }