summaryrefslogtreecommitdiff
path: root/libinterp/xec.c
diff options
context:
space:
mode:
Diffstat (limited to 'libinterp/xec.c')
-rw-r--r--libinterp/xec.c1692
1 files changed, 1692 insertions, 0 deletions
diff --git a/libinterp/xec.c b/libinterp/xec.c
new file mode 100644
index 00000000..9f6792e9
--- /dev/null
+++ b/libinterp/xec.c
@@ -0,0 +1,1692 @@
+#include <lib9.h>
+#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 Stmp *((WORD*)(R.FP+NREG*IBY2WD))
+#define Dtmp *((WORD*)(R.FP+(NREG+2)*IBY2WD))
+
+#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(iexpw)
+{
+ int inv;
+ WORD x, n, r;
+
+ x = W(m);
+ n = W(s);
+ inv = 0;
+ if(n < 0){
+ n = -n;
+ inv = 1;
+ }
+ r = 1;
+ for(;;){
+ if(n&1)
+ r *= x;
+ if((n >>= 1) == 0)
+ break;
+ x *= x;
+ }
+ if(inv)
+ r = 1/r;
+ W(d) = r;
+}
+OP(iexpl)
+{
+ int inv;
+ WORD n;
+ LONG x, r;
+
+ x = V(m);
+ n = W(s);
+ inv = 0;
+ if(n < 0){
+ n = -n;
+ inv = 1;
+ }
+ r = 1;
+ for(;;){
+ if(n&1)
+ r *= x;
+ if((n >>= 1) == 0)
+ break;
+ x *= x;
+ }
+ if(inv)
+ r = 1/r;
+ V(d) = r;
+}
+OP(iexpf)
+{
+ int inv;
+ WORD n;
+ REAL x, r;
+
+ x = F(m);
+ n = W(s);
+ inv = 0;
+ if(n < 0){
+ n = -n;
+ inv = 1;
+ }
+ r = 1;
+ for(;;){
+ if(n&1)
+ r *= x;
+ if((n >>= 1) == 0)
+ break;
+ x *= x;
+ }
+ if(inv)
+ r = 1/r;
+ F(d) = r;
+}
+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;
+ int o;
+
+ ml = *(Modlink**)R.s;
+ if(ml == H)
+ error(exModule);
+
+ o = W(m);
+ if(o >= 0){
+ if(o >= ml->nlinks)
+ error("invalid mframe");
+ t = ml->links[o].frame;
+ }
+ else
+ t = ml->m->ext[-o-1].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 && tsz != 0)
+ 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(Type *t, void (*mover)(void), int len)
+{
+ Heap *h;
+ Channel *c;
+
+ h = heap(&Tchannel);
+ c = H2D(Channel*, h);
+ c->send = (Progq*)malloc(sizeof(Progq));
+ c->recv = (Progq*)malloc(sizeof(Progq));
+ if(c->send == nil || c->recv == nil){
+ free(c->send);
+ free(c->recv);
+ error(exNomem);
+ }
+ c->send->prog = c->recv->prog = nil;
+ c->send->next = c->recv->next = nil;
+ c->mover = mover;
+ c->buf = H;
+ if(len > 0)
+ c->buf = H2D(Array*, heaparray(t, len));
+ c->front = 0;
+ c->size = 0;
+ if(mover == movtmp){
+ c->mid.t = t;
+ t->ref++;
+ }
+ return c;
+}
+Channel*
+newc(Type *t, void (*mover)(void))
+{
+ Channel **cp, *oldc;
+ WORD len;
+
+ len = 0;
+ if(R.m != R.d){
+ len = W(m);
+ if(len < 0)
+ error(exNegsize);
+ }
+ cp = R.d;
+ oldc = *cp;
+ *cp = cnewc(t, mover, len);
+ destroy(oldc);
+ return *cp;
+}
+OP(newcl) { newc(&Tlong, movl); }
+OP(newcb) { newc(&Tbyte, movb); }
+OP(newcw) { newc(&Tword, movw); }
+OP(newcf) { newc(&Treal, movf); }
+OP(newcp) { newc(&Tptr, movp); }
+OP(newcm)
+{
+ Channel *c;
+ Type *t;
+
+ t = nil;
+ if(R.m != R.d && W(m) > 0)
+ t = dtype(nil, W(s), nil, 0);
+ c = newc(t, movm);
+ c->mid.w = W(s);
+ if(t != nil)
+ freetype(t);
+}
+OP(newcmp)
+{
+ newc(R.M->type[W(s)], movtmp);
+}
+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(casel)
+{
+ WORD *t, *l, d, n, n2;
+ LONG v;
+
+ v = V(s);
+ t = (WORD*)((WORD)R.d + 2*IBY2WD);
+ n = t[-2];
+ d = t[n*6];
+
+ while(n > 0) {
+ n2 = n >> 1;
+ l = t + n2*6;
+ if(v < ((LONG*)l)[0]) {
+ n = n2;
+ continue;
+ }
+ if(v >= ((LONG*)l)[1]) {
+ t = l+6;
+ n -= n2 + 1;
+ continue;
+ }
+ d = l[4];
+ break;
+ }
+ if(R.M->compiled) {
+ R.PC = (Inst*)d;
+ return;
+ }
+ R.PC = R.M->prog + d;
+}
+OP(casec)
+{
+ WORD *l, *t, *e, n, n2, r;
+ String *sl, *sh, *sv;
+
+ sv = S(s);
+ t = (WORD*)((WORD)R.d + IBY2WD);
+ n = t[-1];
+ e = t + n*3;
+ if(n > 2){
+ while(n > 0){
+ n2 = n>>1;
+ l = t + n2*3;
+ sl = (String*)l[0];
+ r = stringcmp(sv, sl);
+ if(r == 0){
+ e = &l[2];
+ break;
+ }
+ if(r < 0){
+ n = n2;
+ continue;
+ }
+ sh = (String*)l[1];
+ if(sh == H || stringcmp(sv, sh) > 0){
+ t = l+3;
+ n -= n2+1;
+ continue;
+ }
+ e = &l[2];
+ break;
+ }
+ t = e;
+ }
+ else{
+ 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;
+ int o;
+
+ ml = *(Modlink**)R.d;
+ if(ml == H)
+ error(exModule);
+ if(ml->prog == nil)
+ error(exSpawn);
+ p = newprog(currun(), ml);
+ o = W(m);
+ if(o >= 0)
+ p->R.PC = ml->links[o].u.pc;
+ else
+ p->R.PC = ml->m->ext[-o-1].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;
+ Import *ldt;
+ Module *m;
+ Modlink *ml, **mp, *t;
+
+ n = string2c(S(s));
+ m = R.M->m;
+ if(m->rt & HASLDT)
+ ldt = m->ldt[W(m)];
+ else{
+ ldt = nil;
+ error("obsolete dis");
+ }
+
+ if(strcmp(n, "$self") == 0) {
+ m->ref++;
+ ml = linkmod(m, ldt, 0);
+ if(ml != H) {
+ ml->MP = R.M->MP;
+ D2H(ml->MP)->ref++;
+ }
+ }
+ else {
+ m = readmod(n, lookmod(n), 1);
+ ml = linkmod(m, ldt, 1);
+ }
+
+ mp = R.d;
+ t = *mp;
+ *mp = ml;
+ destroy(t);
+}
+OP(mcall)
+{
+ Heap *h;
+ Prog *p;
+ Frame *f;
+ Linkpc *l;
+ Modlink *ml;
+ int o;
+
+ 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++;
+
+ o = W(m);
+ if(o >= 0)
+ l = &ml->links[o].u;
+ else
+ l = &ml->m->ext[-o-1].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;
+}
+static int
+cgetb(Channel *c, void *v)
+{
+ Array *a;
+ void *w;
+
+ if((a = c->buf) == H)
+ return 0;
+ if(c->size > 0){
+ w = a->data+c->front*a->t->size;
+ c->front++;
+ if(c->front == c->buf->len)
+ c->front = 0;
+ c->size--;
+ R.s = w;
+ R.m = &c->mid;
+ R.d = v;
+ c->mover();
+ if(a->t->np){
+ freeptrs(w, a->t);
+ initmem(a->t, w);
+ }
+ return 1;
+ }
+ return 0;
+}
+static int
+cputb(Channel *c, void *v)
+{
+ Array *a;
+ WORD len, r;
+
+ if((a = c->buf) == H)
+ return 0;
+ len = c->buf->len;
+ if(c->size < len){
+ r = c->front+c->size;
+ if(r >= len)
+ r -= len;
+ c->size++;
+ R.s = v;
+ R.m = &c->mid;
+ R.d = a->data+r*a->t->size;
+ c->mover();
+ return 1;
+ }
+ return 0;
+}
+/*
+int
+cqsize(Progq *q)
+{
+ int n;
+
+ n = 0;
+ for( ; q != nil; q = q->next)
+ if(q->prog != nil)
+ n++;
+ return n;
+}
+*/
+void
+cqadd(Progq **q, Prog *p)
+{
+ Progq *n;
+
+ if((*q)->prog == nil){
+ (*q)->prog = p;
+ return;
+ }
+ n = (Progq*)malloc(sizeof(Progq));
+ if(n == nil)
+ error(exNomem);
+ n->prog = p;
+ n->next = nil;
+ for( ; *q != nil; q = &(*q)->next)
+ ;
+ *q = n;
+}
+void
+cqdel(Progq **q)
+{
+ Progq *f;
+
+ if((*q)->next == nil){
+ (*q)->prog = nil;
+ return;
+ }
+ f = *q;
+ *q = f->next;
+ free(f);
+}
+void
+cqdelp(Progq **q, Prog *p)
+{
+ Progq *f;
+
+ if((*q)->next == nil){
+ if((*q)->prog == p)
+ (*q)->prog = nil;
+ return;
+ }
+ for( ; *q != nil; ){
+ if((*q)->prog == p){
+ f = *q;
+ *q = (*q)->next;
+ free(f);
+ }
+ else
+ q = &(*q)->next;
+ }
+}
+OP(isend)
+{
+ Channel *c;
+ Prog *p;
+
+ c = C(d);
+ if(c == H)
+ error(exNilref);
+
+ if((p = c->recv->prog) == nil) {
+ if(c->buf != H && cputb(c, R.s))
+ return;
+ p = delrun(Psend);
+ p->ptr = R.s;
+ p->chan = c; /* for killprog */
+ R.IC = 1;
+ R.t = 1;
+ cqadd(&c->send, p);
+ return;
+ }
+
+ if(c->buf != H && c->size > 0)
+ print("non-empty buffer in isend\n");
+
+ cqdel(&c->recv);
+ if(p->state == Palt)
+ altdone(p->R.s, p, c, 1);
+
+ R.m = &c->mid;
+ R.d = p->ptr;
+ p->ptr = nil;
+ c->mover();
+ addrun(p);
+ R.t = 0;
+}
+OP(irecv)
+{
+ Channel *c;
+ Prog *p;
+
+ c = C(s);
+ if(c == H)
+ error(exNilref);
+
+ if((p = c->send->prog) == nil) {
+ if(c->buf != H && cgetb(c, R.d))
+ return;
+ p = delrun(Precv);
+ p->ptr = R.d;
+ p->chan = c; /* for killprog */
+ R.IC = 1;
+ R.t = 1;
+ cqadd(&c->recv, p);
+ return;
+ }
+
+ if(c->buf != H && c->size != c->buf->len)
+ print("non-full buffer in irecv\n");
+
+ cqdel(&c->send);
+ if(p->state == Palt)
+ altdone(p->R.s, p, c, 0);
+
+ if(c->buf != H){
+ cgetb(c, R.d);
+ cputb(c, p->ptr);
+ p->ptr = nil;
+ }
+ else{
+ R.m = &c->mid;
+ R.s = p->ptr;
+ p->ptr = nil;
+ c->mover();
+ }
+ addrun(p);
+ R.t = 0;
+}
+int
+csendalt(Channel *c, void *ip, Type *t, int len)
+{
+ REG rsav;
+
+ if(c == H)
+ error(exNilref);
+
+ if(c->recv->prog == nil && (c->buf == H || c->size == c->buf->len)){
+ if(c->buf != H){
+ print("csendalt failed\n");
+ freeptrs(ip, t);
+ return 0;
+ }
+ c->buf = H2D(Array*, heaparray(t, len));
+ }
+
+ rsav = R;
+ R.s = ip;
+ R.d = &c;
+ isend();
+ R = rsav;
+ freeptrs(ip, t);
+ return 1;
+}
+
+List*
+cons(ulong size, List **lp)
+{
+ Heap *h;
+ List *lv, *l;
+
+ h = nheap(sizeof(List) + size - sizeof(((List*)0)->data));
+ 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 < 0 || 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)
+{
+ /* spare slot */
+}
+OP(badop)
+{
+ error(exOp);
+}
+OP(iraise)
+{
+ void *v;
+ Heap *h;
+ Prog *p;
+
+ p = currun();
+ v = T(s);
+ if(v == H)
+ error(exNilref);
+ p->exval = v;
+ h = D2H(v);
+ h->ref++;
+ if(h->t == &Tstring)
+ error(string2c((String*)v));
+ else
+ error(string2c(*(String**)v));
+}
+OP(mulx)
+{
+ WORD p;
+ LONG r;
+
+ p = Dtmp;
+ r = (LONG)W(m)*(LONG)W(s);
+ if(p >= 0)
+ r <<= p;
+ else
+ r >>= (-p);
+ W(d) = (WORD)r;
+}
+OP(divx)
+{
+ WORD p;
+ LONG s;
+
+ p = Dtmp;
+ s = (LONG)W(m);
+ if(p >= 0)
+ s <<= p;
+ else
+ s >>= (-p);
+ s /= (LONG)W(s);
+ W(d) = (WORD)s;
+}
+OP(cvtxx)
+{
+ WORD p;
+ LONG r;
+
+ p = W(m);
+ r = (LONG)W(s);
+ if(p >= 0)
+ r <<= p;
+ else
+ r >>= (-p);
+ W(d) = (WORD)r;
+}
+OP(mulx0)
+{
+ WORD x, y, p, a;
+ LONG r;
+
+ x = W(m);
+ y = W(s);
+ p = Dtmp;
+ a = Stmp;
+ if(x == 0 || y == 0){
+ W(d) = 0;
+ return;
+ }
+ r = (LONG)x*(LONG)y;
+ if(p >= 0)
+ r <<= p;
+ else
+ r >>= (-p);
+ r /= (LONG)a;
+ W(d) = (WORD)r;
+}
+OP(divx0)
+{
+ WORD x, y, p, b;
+ LONG s;
+
+ x = W(m);
+ y = W(s);
+ p = Dtmp;
+ b = Stmp;
+ if(x == 0){
+ W(d) = 0;
+ return;
+ }
+ s = (LONG)b*(LONG)x;
+ if(p >= 0)
+ s <<= p;
+ else
+ s >>= (-p);
+ s /= (LONG)y;
+ W(d) = (WORD)s;
+}
+OP(cvtxx0)
+{
+ WORD x, p, a;
+ LONG r;
+
+ x = W(s);
+ p = W(m);
+ a = Stmp;
+ if(x == 0){
+ W(d) = 0;
+ return;
+ }
+ r = (LONG)x;
+ if(p >= 0)
+ r <<= p;
+ else
+ r >>= (-p);
+ r /= (LONG)a;
+ W(d) = (WORD)r;
+}
+OP(mulx1)
+{
+ WORD x, y, p, a, v;
+ int vnz, wnz;
+ LONG w, r;
+
+ x = W(m);
+ y = W(s);
+ p = Dtmp;
+ a = Stmp;
+ if(x == 0 || y == 0){
+ W(d) = 0;
+ return;
+ }
+ vnz = p&2;
+ wnz = p&1;
+ p >>= 2;
+ v = 0;
+ w = 0;
+ if(vnz){
+ v = a-1;
+ if(x >= 0 && y < 0 || x < 0 && y >= 0)
+ v = -v;
+ }
+ if(wnz){
+ if((!vnz && (x > 0 && y < 0 || x < 0 && y > 0)) ||
+ (vnz && (x > 0 && y > 0 || x < 0 && y < 0)))
+ w = ((LONG)1<<(-p)) - 1;
+ }
+ r = (LONG)x*(LONG)y + w;
+ if(p >= 0)
+ r <<= p;
+ else
+ r >>= (-p);
+ r += (LONG)v;
+ r /= (LONG)a;
+ W(d) = (WORD)r;
+}
+OP(divx1)
+{
+ WORD x, y, p, b, v;
+ int vnz, wnz;
+ LONG w, s;
+
+ x = W(m);
+ y = W(s);
+ p = Dtmp;
+ b = Stmp;
+ if(x == 0){
+ W(d) = 0;
+ return;
+ }
+ vnz = p&2;
+ wnz = p&1;
+ p >>= 2;
+ v = 0;
+ w = 0;
+ if(vnz){
+ v = 1;
+ if(x >= 0 && y < 0 || x < 0 && y >= 0)
+ v = -v;
+ }
+ if(wnz){
+ if(x <= 0)
+ w = ((LONG)1<<(-p)) - 1;
+ }
+ s = (LONG)b*(LONG)x + w;
+ if(p >= 0)
+ s <<= p;
+ else
+ s >>= (-p);
+ s /= (LONG)y;
+ W(d) = (WORD)s + v;
+}
+OP(cvtxx1)
+{
+ WORD x, p, a, v;
+ int vnz, wnz;
+ LONG w, r;
+
+ x = W(s);
+ p = W(m);
+ a = Stmp;
+ if(x == 0){
+ W(d) = 0;
+ return;
+ }
+ vnz = p&2;
+ wnz = p&1;
+ p >>= 2;
+ v = 0;
+ w = 0;
+ if(vnz){
+ v = a-1;
+ if(x < 0)
+ v = -v;
+ }
+ if(wnz){
+ if(!vnz && x < 0 || vnz && x > 0)
+ w = ((LONG)1<<(-p)) - 1;
+ }
+ r = (LONG)x + w;
+ if(p >= 0)
+ r <<= p;
+ else
+ r >>= (-p);
+ r += (LONG)v;
+ r /= (LONG)a;
+ W(d) = (WORD)r;
+}
+/*
+OP(cvtxx)
+{
+ REAL v;
+
+ v = (REAL)W(s)*F(m);
+ v = v < 0 ? v-0.5: v+0.5;
+ W(d) = (WORD)v;
+}
+*/
+OP(cvtfx)
+{
+ REAL v;
+
+ v = F(s)*F(m);
+ v = v < 0 ? v-0.5: v+0.5;
+ W(d) = (WORD)v;
+}
+OP(cvtxf)
+{
+ F(d) = (REAL)W(s)*F(m);
+}
+
+OP(self)
+{
+ Modlink *ml, **mp, *t;
+
+ ml = R.M;
+ D2H(ml)->ref++;
+ mp = R.d;
+ t = *mp;
+ *mp = ml;
+ destroy(t);
+}
+
+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;
+ if(f == nil)
+ break;
+ 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);
+ reg->M = H; /* for devprof */
+}
+
+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);
+ }
+
+// print("%lux %lux %lux %lux %lux\n", (ulong)&R, R.xpc, R.FP, R.MP, R.PC);
+
+ 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;
+}
generated by cgit v1.2.3 (git 2.46.0) at 2025-12-10 07:31:00 +0000