123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443444445446447448449450451452453454455456457458459460461462463464465466467468469470471472473474475476477478479480481482483484485486487488489490491492493494495496497498499500501502503504505506507508509510511512513514515516517518519520521522523524525526527528529530531532533534535536537538539540541542543544545546547548549550551552553554555556557558559560561562563564565566567568569570571572573574575576577578579580581582583584585586587588589590591592593594595596597598599600601602603604605606607608609610611612613614615616617618619620621622623624625626627628629630631632633634635636637638639640641642643644645646647648649650651652653654655656657658659660661662663664665666667668669670671672673674675676677678679680681682683684685686687688689690691692693694695696697698699700701702703704705706707708709710711712713714715716717718719720721722723724725726727728729730731732733734735736737738739740741742743744745746747748749750751752753754755756757758759760761762763764765766767768769770771772773774775776777778779780781782783784785786787788789790791792793794795796797798799800801802803804805806807808809810811812813814815816817818819820821822823824825826827828829830831832833834835836837838839840841842843844845846847848849850851852853854855856857858859860861862863864865866867868869870871872873874875876877878879880881882883884885886887888889890891892893894895896897898899900901902903904905906907908909910911912913914915916917918919920921922923924925926927928929930931932933934935936937938939940941942943944945946947948949950951952953954955956957958959960961962963964965966967968969970971972973974975976977978979980981982983984985986987988989990991992993994995996997998999100010011002100310041005100610071008100910101011101210131014101510161017101810191020102110221023102410251026102710281029103010311032103310341035103610371038103910401041104210431044104510461047104810491050105110521053105410551056105710581059106010611062106310641065106610671068106910701071107210731074107510761077107810791080108110821083108410851086108710881089109010911092109310941095109610971098109911001101110211031104110511061107110811091110111111121113111411151116111711181119112011211122112311241125112611271128112911301131113211331134113511361137113811391140114111421143114411451146114711481149115011511152115311541155115611571158115911601161116211631164116511661167116811691170117111721173117411751176117711781179118011811182118311841185118611871188118911901191119211931194119511961197119811991200120112021203120412051206120712081209121012111212121312141215121612171218121912201221122212231224122512261227122812291230123112321233123412351236123712381239124012411242124312441245124612471248124912501251125212531254125512561257125812591260126112621263126412651266126712681269127012711272127312741275127612771278127912801281128212831284128512861287128812891290129112921293129412951296129712981299130013011302130313041305130613071308130913101311131213131314131513161317131813191320132113221323132413251326132713281329133013311332133313341335133613371338133913401341134213431344134513461347134813491350135113521353135413551356135713581359136013611362136313641365136613671368136913701371137213731374137513761377137813791380138113821383138413851386138713881389139013911392139313941395139613971398139914001401140214031404140514061407140814091410141114121413141414151416141714181419142014211422142314241425142614271428142914301431143214331434143514361437143814391440144114421443144414451446144714481449145014511452145314541455145614571458145914601461146214631464146514661467146814691470147114721473147414751476147714781479148014811482148314841485148614871488148914901491149214931494149514961497149814991500150115021503150415051506150715081509151015111512151315141515151615171518151915201521152215231524152515261527152815291530153115321533153415351536153715381539154015411542154315441545154615471548154915501551155215531554155515561557155815591560156115621563156415651566156715681569157015711572157315741575157615771578157915801581158215831584158515861587158815891590159115921593159415951596159715981599160016011602160316041605160616071608160916101611161216131614161516161617161816191620162116221623162416251626162716281629163016311632163316341635163616371638163916401641164216431644164516461647164816491650165116521653165416551656165716581659166016611662166316641665166616671668166916701671167216731674167516761677167816791680168116821683168416851686168716881689169016911692169316941695169616971698 |
- #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 = malloc(sizeof(Progq));
- c->recv = 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;
- Heap *h;
- 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;
- h = D2H(ml->MP);
- h->ref++;
- Setmark(h);
- }
- }
- 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;
- Heap *h;
- ml = R.M;
- h = D2H(ml);
- h->ref++;
- Setmark(h);
- 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;
- }
|