1 #include <lib9.h>
2 #include "isa.h"
3 #include "interp.h"
4 #include "raise.h"
5 #include "pool.h"
6
7 REG R; /* Virtual Machine registers */
8 String snil; /* String known to be zero length */
9
10 #define Stmp *((WORD*)(R.FP+NREG*IBY2WD))
11 #define Dtmp *((WORD*)(R.FP+(NREG+2)*IBY2WD))
12
13 #define OP(fn) void fn(void)
14 #define B(r) *((BYTE*)(R.r))
15 #define W(r) *((WORD*)(R.r))
16 #define UW(r) *((UWORD*)(R.r))
17 #define F(r) *((REAL*)(R.r))
18 #define V(r) *((LONG*)(R.r))
19 #define UV(r) *((ULONG*)(R.r))
20 #define S(r) *((String**)(R.r))
21 #define A(r) *((Array**)(R.r))
22 #define L(r) *((List**)(R.r))
23 #define P(r) *((WORD**)(R.r))
24 #define C(r) *((Channel**)(R.r))
25 #define T(r) *((void**)(R.r))
26 #define JMP(r) R.PC = *(Inst**)(R.r)
27 #define SH(r) *((SHORT*)(R.r))
28 #define SR(r) *((SREAL*)(R.r))
29
OP(runt)30 OP(runt) {}
OP(negf)31 OP(negf) { F(d) = -F(s); }
OP(jmp)32 OP(jmp) { JMP(d); }
OP(movpc)33 OP(movpc){ T(d) = &R.M->prog[W(s)]; }
OP(movm)34 OP(movm) { memmove(R.d, R.s, W(m)); }
OP(lea)35 OP(lea) { W(d) = (WORD)R.s; }
OP(movb)36 OP(movb) { B(d) = B(s); }
OP(movw)37 OP(movw) { W(d) = W(s); }
OP(movf)38 OP(movf) { F(d) = F(s); }
OP(movl)39 OP(movl) { V(d) = V(s); }
OP(cvtbw)40 OP(cvtbw){ W(d) = B(s); }
OP(cvtwb)41 OP(cvtwb){ B(d) = W(s); }
OP(cvtrf)42 OP(cvtrf){ F(d) = SR(s); }
OP(cvtfr)43 OP(cvtfr){ SR(d) = F(s); }
OP(cvtws)44 OP(cvtws){ SH(d) = W(s); }
OP(cvtsw)45 OP(cvtsw){ W(d) = SH(s); }
OP(cvtwf)46 OP(cvtwf){ F(d) = W(s); }
OP(addb)47 OP(addb) { B(d) = B(m) + B(s); }
OP(addw)48 OP(addw) { W(d) = W(m) + W(s); }
OP(addl)49 OP(addl) { V(d) = V(m) + V(s); }
OP(addf)50 OP(addf) { F(d) = F(m) + F(s); }
OP(subb)51 OP(subb) { B(d) = B(m) - B(s); }
OP(subw)52 OP(subw) { W(d) = W(m) - W(s); }
OP(subl)53 OP(subl) { V(d) = V(m) - V(s); }
OP(subf)54 OP(subf) { F(d) = F(m) - F(s); }
OP(divb)55 OP(divb) { B(d) = B(m) / B(s); }
OP(divw)56 OP(divw) { W(d) = W(m) / W(s); }
OP(divl)57 OP(divl) { V(d) = V(m) / V(s); }
OP(divf)58 OP(divf) { F(d) = F(m) / F(s); }
OP(modb)59 OP(modb) { B(d) = B(m) % B(s); }
OP(modw)60 OP(modw) { W(d) = W(m) % W(s); }
OP(modl)61 OP(modl) { V(d) = V(m) % V(s); }
OP(mulb)62 OP(mulb) { B(d) = B(m) * B(s); }
OP(mulw)63 OP(mulw) { W(d) = W(m) * W(s); }
OP(mull)64 OP(mull) { V(d) = V(m) * V(s); }
OP(mulf)65 OP(mulf) { F(d) = F(m) * F(s); }
OP(andb)66 OP(andb) { B(d) = B(m) & B(s); }
OP(andw)67 OP(andw) { W(d) = W(m) & W(s); }
OP(andl)68 OP(andl) { V(d) = V(m) & V(s); }
OP(xorb)69 OP(xorb) { B(d) = B(m) ^ B(s); }
OP(xorw)70 OP(xorw) { W(d) = W(m) ^ W(s); }
OP(xorl)71 OP(xorl) { V(d) = V(m) ^ V(s); }
OP(orb)72 OP(orb) { B(d) = B(m) | B(s); }
OP(orw)73 OP(orw) { W(d) = W(m) | W(s); }
OP(orl)74 OP(orl) { V(d) = V(m) | V(s); }
OP(shlb)75 OP(shlb) { B(d) = B(m) << W(s); }
OP(shlw)76 OP(shlw) { W(d) = W(m) << W(s); }
OP(shll)77 OP(shll) { V(d) = V(m) << W(s); }
OP(shrb)78 OP(shrb) { B(d) = B(m) >> W(s); }
OP(shrw)79 OP(shrw) { W(d) = W(m) >> W(s); }
OP(shrl)80 OP(shrl) { V(d) = V(m) >> W(s); }
OP(lsrw)81 OP(lsrw) { W(d) = UW(m) >> W(s); }
OP(lsrl)82 OP(lsrl) { V(d) = UV(m) >> W(s); }
OP(beqb)83 OP(beqb) { if(B(s) == B(m)) JMP(d); }
OP(bneb)84 OP(bneb) { if(B(s) != B(m)) JMP(d); }
OP(bltb)85 OP(bltb) { if(B(s) < B(m)) JMP(d); }
OP(bleb)86 OP(bleb) { if(B(s) <= B(m)) JMP(d); }
OP(bgtb)87 OP(bgtb) { if(B(s) > B(m)) JMP(d); }
OP(bgeb)88 OP(bgeb) { if(B(s) >= B(m)) JMP(d); }
OP(beqw)89 OP(beqw) { if(W(s) == W(m)) JMP(d); }
OP(bnew)90 OP(bnew) { if(W(s) != W(m)) JMP(d); }
OP(bltw)91 OP(bltw) { if(W(s) < W(m)) JMP(d); }
OP(blew)92 OP(blew) { if(W(s) <= W(m)) JMP(d); }
OP(bgtw)93 OP(bgtw) { if(W(s) > W(m)) JMP(d); }
OP(bgew)94 OP(bgew) { if(W(s) >= W(m)) JMP(d); }
OP(beql)95 OP(beql) { if(V(s) == V(m)) JMP(d); }
OP(bnel)96 OP(bnel) { if(V(s) != V(m)) JMP(d); }
OP(bltl)97 OP(bltl) { if(V(s) < V(m)) JMP(d); }
OP(blel)98 OP(blel) { if(V(s) <= V(m)) JMP(d); }
OP(bgtl)99 OP(bgtl) { if(V(s) > V(m)) JMP(d); }
OP(bgel)100 OP(bgel) { if(V(s) >= V(m)) JMP(d); }
OP(beqf)101 OP(beqf) { if(F(s) == F(m)) JMP(d); }
OP(bnef)102 OP(bnef) { if(F(s) != F(m)) JMP(d); }
OP(bltf)103 OP(bltf) { if(F(s) < F(m)) JMP(d); }
OP(blef)104 OP(blef) { if(F(s) <= F(m)) JMP(d); }
OP(bgtf)105 OP(bgtf) { if(F(s) > F(m)) JMP(d); }
OP(bgef)106 OP(bgef) { if(F(s) >= F(m)) JMP(d); }
OP(beqc)107 OP(beqc) { if(stringcmp(S(s), S(m)) == 0) JMP(d); }
OP(bnec)108 OP(bnec) { if(stringcmp(S(s), S(m)) != 0) JMP(d); }
OP(bltc)109 OP(bltc) { if(stringcmp(S(s), S(m)) < 0) JMP(d); }
OP(blec)110 OP(blec) { if(stringcmp(S(s), S(m)) <= 0) JMP(d); }
OP(bgtc)111 OP(bgtc) { if(stringcmp(S(s), S(m)) > 0) JMP(d); }
OP(bgec)112 OP(bgec) { if(stringcmp(S(s), S(m)) >= 0) JMP(d); }
OP(iexit)113 OP(iexit){ error(""); }
OP(cvtwl)114 OP(cvtwl){ V(d) = W(s); }
OP(cvtlw)115 OP(cvtlw){ W(d) = V(s); }
OP(cvtlf)116 OP(cvtlf){ F(d) = V(s); }
OP(cvtfl)117 OP(cvtfl)
118 {
119 REAL f;
120
121 f = F(s);
122 V(d) = f < 0 ? f - .5 : f + .5;
123 }
OP(cvtfw)124 OP(cvtfw)
125 {
126 REAL f;
127
128 f = F(s);
129 W(d) = f < 0 ? f - .5 : f + .5;
130 }
OP(cvtcl)131 OP(cvtcl)
132 {
133 String *s;
134
135 s = S(s);
136 if(s == H)
137 V(d) = 0;
138 else
139 V(d) = strtoll(string2c(s), nil, 10);
140 }
OP(iexpw)141 OP(iexpw)
142 {
143 int inv;
144 WORD x, n, r;
145
146 x = W(m);
147 n = W(s);
148 inv = 0;
149 if(n < 0){
150 n = -n;
151 inv = 1;
152 }
153 r = 1;
154 for(;;){
155 if(n&1)
156 r *= x;
157 if((n >>= 1) == 0)
158 break;
159 x *= x;
160 }
161 if(inv)
162 r = 1/r;
163 W(d) = r;
164 }
OP(iexpl)165 OP(iexpl)
166 {
167 int inv;
168 WORD n;
169 LONG x, r;
170
171 x = V(m);
172 n = W(s);
173 inv = 0;
174 if(n < 0){
175 n = -n;
176 inv = 1;
177 }
178 r = 1;
179 for(;;){
180 if(n&1)
181 r *= x;
182 if((n >>= 1) == 0)
183 break;
184 x *= x;
185 }
186 if(inv)
187 r = 1/r;
188 V(d) = r;
189 }
OP(iexpf)190 OP(iexpf)
191 {
192 int inv;
193 WORD n;
194 REAL x, r;
195
196 x = F(m);
197 n = W(s);
198 inv = 0;
199 if(n < 0){
200 n = -n;
201 inv = 1;
202 }
203 r = 1;
204 for(;;){
205 if(n&1)
206 r *= x;
207 if((n >>= 1) == 0)
208 break;
209 x *= x;
210 }
211 if(inv)
212 r = 1/r;
213 F(d) = r;
214 }
OP(indx)215 OP(indx)
216 {
217 ulong i;
218 Array *a;
219
220 a = A(s);
221 i = W(d);
222 if(a == H || i >= a->len)
223 error(exBounds);
224 W(m) = (WORD)(a->data+i*a->t->size);
225 }
OP(indw)226 OP(indw)
227 {
228 ulong i;
229 Array *a;
230
231 a = A(s);
232 i = W(d);
233 if(a == H || i >= a->len)
234 error(exBounds);
235 W(m) = (WORD)(a->data+i*sizeof(WORD));
236 }
OP(indf)237 OP(indf)
238 {
239 ulong i;
240 Array *a;
241
242 a = A(s);
243 i = W(d);
244 if(a == H || i >= a->len)
245 error(exBounds);
246 W(m) = (WORD)(a->data+i*sizeof(REAL));
247 }
OP(indl)248 OP(indl)
249 {
250 ulong i;
251 Array *a;
252
253 a = A(s);
254 i = W(d);
255 if(a == H || i >= a->len)
256 error(exBounds);
257 W(m) = (WORD)(a->data+i*sizeof(LONG));
258 }
OP(indb)259 OP(indb)
260 {
261 ulong i;
262 Array *a;
263
264 a = A(s);
265 i = W(d);
266 if(a == H || i >= a->len)
267 error(exBounds);
268 W(m) = (WORD)(a->data+i*sizeof(BYTE));
269 }
OP(movp)270 OP(movp)
271 {
272 Heap *h;
273 WORD *dv, *sv;
274
275 sv = P(s);
276 if(sv != H) {
277 h = D2H(sv);
278 h->ref++;
279 Setmark(h);
280 }
281 dv = P(d);
282 P(d) = sv;
283 destroy(dv);
284 }
OP(movmp)285 OP(movmp)
286 {
287 Type *t;
288
289 t = R.M->type[W(m)];
290
291 incmem(R.s, t);
292 if (t->np)
293 freeptrs(R.d, t);
294 memmove(R.d, R.s, t->size);
295 }
OP(new)296 OP(new)
297 {
298 Heap *h;
299 WORD **wp, *t;
300
301 h = heap(R.M->type[W(s)]);
302 wp = R.d;
303 t = *wp;
304 *wp = H2D(WORD*, h);
305 destroy(t);
306 }
OP(newz)307 OP(newz)
308 {
309 Heap *h;
310 WORD **wp, *t;
311
312 h = heapz(R.M->type[W(s)]);
313 wp = R.d;
314 t = *wp;
315 *wp = H2D(WORD*, h);
316 destroy(t);
317 }
OP(mnewz)318 OP(mnewz)
319 {
320 Heap *h;
321 WORD **wp, *t;
322 Modlink *ml;
323
324 ml = *(Modlink**)R.s;
325 if(ml == H)
326 error(exModule);
327 h = heapz(ml->type[W(m)]);
328 wp = R.d;
329 t = *wp;
330 *wp = H2D(WORD*, h);
331 destroy(t);
332 }
OP(frame)333 OP(frame)
334 {
335 Type *t;
336 Frame *f;
337 uchar *nsp;
338
339 t = R.M->type[W(s)];
340 nsp = R.SP + t->size;
341 if(nsp >= R.TS) {
342 R.s = t;
343 extend();
344 T(d) = R.s;
345 return;
346 }
347 f = (Frame*)R.SP;
348 R.SP = nsp;
349 f->t = t;
350 f->mr = nil;
351 if (t->np)
352 initmem(t, f);
353 T(d) = f;
354 }
OP(mframe)355 OP(mframe)
356 {
357 Type *t;
358 Frame *f;
359 uchar *nsp;
360 Modlink *ml;
361 int o;
362
363 ml = *(Modlink**)R.s;
364 if(ml == H)
365 error(exModule);
366
367 o = W(m);
368 if(o >= 0){
369 if(o >= ml->nlinks)
370 error("invalid mframe");
371 t = ml->links[o].frame;
372 }
373 else
374 t = ml->m->ext[-o-1].frame;
375 nsp = R.SP + t->size;
376 if(nsp >= R.TS) {
377 R.s = t;
378 extend();
379 T(d) = R.s;
380 return;
381 }
382 f = (Frame*)R.SP;
383 R.SP = nsp;
384 f->t = t;
385 f->mr = nil;
386 if (t->np)
387 initmem(t, f);
388 T(d) = f;
389 }
390 void
acheck(int tsz,int sz)391 acheck(int tsz, int sz)
392 {
393 if(sz < 0)
394 error(exNegsize);
395 /* test for overflow; assumes sz >>> tsz */
396 if((int)(sizeof(Array) + sizeof(Heap) + tsz*sz) < sz && tsz != 0)
397 error(exHeap);
398 }
OP(newa)399 OP(newa)
400 {
401 int sz;
402 Type *t;
403 Heap *h;
404 Array *a, *at, **ap;
405
406 t = R.M->type[W(m)];
407 sz = W(s);
408 acheck(t->size, sz);
409 h = nheap(sizeof(Array) + (t->size*sz));
410 h->t = &Tarray;
411 Tarray.ref++;
412 a = H2D(Array*, h);
413 a->t = t;
414 a->len = sz;
415 a->root = H;
416 a->data = (uchar*)a + sizeof(Array);
417 initarray(t, a);
418
419 ap = R.d;
420 at = *ap;
421 *ap = a;
422 destroy(at);
423 }
OP(newaz)424 OP(newaz)
425 {
426 int sz;
427 Type *t;
428 Heap *h;
429 Array *a, *at, **ap;
430
431 t = R.M->type[W(m)];
432 sz = W(s);
433 acheck(t->size, sz);
434 h = nheap(sizeof(Array) + (t->size*sz));
435 h->t = &Tarray;
436 Tarray.ref++;
437 a = H2D(Array*, h);
438 a->t = t;
439 a->len = sz;
440 a->root = H;
441 a->data = (uchar*)a + sizeof(Array);
442 memset(a->data, 0, t->size*sz);
443 initarray(t, a);
444
445 ap = R.d;
446 at = *ap;
447 *ap = a;
448 destroy(at);
449 }
450 Channel*
cnewc(Type * t,void (* mover)(void),int len)451 cnewc(Type *t, void (*mover)(void), int len)
452 {
453 Heap *h;
454 Channel *c;
455
456 h = heap(&Tchannel);
457 c = H2D(Channel*, h);
458 c->send = malloc(sizeof(Progq));
459 c->recv = malloc(sizeof(Progq));
460 if(c->send == nil || c->recv == nil){
461 free(c->send);
462 free(c->recv);
463 error(exNomem);
464 }
465 c->send->prog = c->recv->prog = nil;
466 c->send->next = c->recv->next = nil;
467 c->mover = mover;
468 c->buf = H;
469 if(len > 0)
470 c->buf = H2D(Array*, heaparray(t, len));
471 c->front = 0;
472 c->size = 0;
473 if(mover == movtmp){
474 c->mid.t = t;
475 t->ref++;
476 }
477 return c;
478 }
479 Channel*
newc(Type * t,void (* mover)(void))480 newc(Type *t, void (*mover)(void))
481 {
482 Channel **cp, *oldc;
483 WORD len;
484
485 len = 0;
486 if(R.m != R.d){
487 len = W(m);
488 if(len < 0)
489 error(exNegsize);
490 }
491 cp = R.d;
492 oldc = *cp;
493 *cp = cnewc(t, mover, len);
494 destroy(oldc);
495 return *cp;
496 }
OP(newcl)497 OP(newcl) { newc(&Tlong, movl); }
OP(newcb)498 OP(newcb) { newc(&Tbyte, movb); }
OP(newcw)499 OP(newcw) { newc(&Tword, movw); }
OP(newcf)500 OP(newcf) { newc(&Treal, movf); }
OP(newcp)501 OP(newcp) { newc(&Tptr, movp); }
OP(newcm)502 OP(newcm)
503 {
504 Channel *c;
505 Type *t;
506
507 t = nil;
508 if(R.m != R.d && W(m) > 0)
509 t = dtype(nil, W(s), nil, 0);
510 c = newc(t, movm);
511 c->mid.w = W(s);
512 if(t != nil)
513 freetype(t);
514 }
OP(newcmp)515 OP(newcmp)
516 {
517 newc(R.M->type[W(s)], movtmp);
518 }
OP(icase)519 OP(icase)
520 {
521 WORD v, *t, *l, d, n, n2;
522
523 v = W(s);
524 t = (WORD*)((WORD)R.d + IBY2WD);
525 n = t[-1];
526 d = t[n*3];
527
528 while(n > 0) {
529 n2 = n >> 1;
530 l = t + n2*3;
531 if(v < l[0]) {
532 n = n2;
533 continue;
534 }
535 if(v >= l[1]) {
536 t = l+3;
537 n -= n2 + 1;
538 continue;
539 }
540 d = l[2];
541 break;
542 }
543 if(R.M->compiled) {
544 R.PC = (Inst*)d;
545 return;
546 }
547 R.PC = R.M->prog + d;
548 }
OP(casel)549 OP(casel)
550 {
551 WORD *t, *l, d, n, n2;
552 LONG v;
553
554 v = V(s);
555 t = (WORD*)((WORD)R.d + 2*IBY2WD);
556 n = t[-2];
557 d = t[n*6];
558
559 while(n > 0) {
560 n2 = n >> 1;
561 l = t + n2*6;
562 if(v < ((LONG*)l)[0]) {
563 n = n2;
564 continue;
565 }
566 if(v >= ((LONG*)l)[1]) {
567 t = l+6;
568 n -= n2 + 1;
569 continue;
570 }
571 d = l[4];
572 break;
573 }
574 if(R.M->compiled) {
575 R.PC = (Inst*)d;
576 return;
577 }
578 R.PC = R.M->prog + d;
579 }
OP(casec)580 OP(casec)
581 {
582 WORD *l, *t, *e, n, n2, r;
583 String *sl, *sh, *sv;
584
585 sv = S(s);
586 t = (WORD*)((WORD)R.d + IBY2WD);
587 n = t[-1];
588 e = t + n*3;
589 if(n > 2){
590 while(n > 0){
591 n2 = n>>1;
592 l = t + n2*3;
593 sl = (String*)l[0];
594 r = stringcmp(sv, sl);
595 if(r == 0){
596 e = &l[2];
597 break;
598 }
599 if(r < 0){
600 n = n2;
601 continue;
602 }
603 sh = (String*)l[1];
604 if(sh == H || stringcmp(sv, sh) > 0){
605 t = l+3;
606 n -= n2+1;
607 continue;
608 }
609 e = &l[2];
610 break;
611 }
612 t = e;
613 }
614 else{
615 while(t < e) {
616 sl = (String*)t[0];
617 sh = (String*)t[1];
618 if(sh == H) {
619 if(stringcmp(sl, sv) == 0) {
620 t = &t[2];
621 goto found;
622 }
623 }
624 else
625 if(stringcmp(sl, sv) <= 0 && stringcmp(sh, sv) >= 0) {
626 t = &t[2];
627 goto found;
628 }
629 t += 3;
630 }
631 }
632 found:
633 if(R.M->compiled) {
634 R.PC = (Inst*)*t;
635 return;
636 }
637 R.PC = R.M->prog + t[0];
638 }
OP(igoto)639 OP(igoto)
640 {
641 WORD *t;
642
643 t = (WORD*)((WORD)R.d + (W(s) * IBY2WD));
644 if(R.M->compiled) {
645 R.PC = (Inst*)t[0];
646 return;
647 }
648 R.PC = R.M->prog + t[0];
649 }
OP(call)650 OP(call)
651 {
652 Frame *f;
653
654 f = T(s);
655 f->lr = R.PC;
656 f->fp = R.FP;
657 R.FP = (uchar*)f;
658 JMP(d);
659 }
OP(spawn)660 OP(spawn)
661 {
662 Prog *p;
663
664 p = newprog(currun(), R.M);
665 p->R.PC = *(Inst**)R.d;
666 newstack(p);
667 unframe();
668 }
OP(mspawn)669 OP(mspawn)
670 {
671 Prog *p;
672 Modlink *ml;
673 int o;
674
675 ml = *(Modlink**)R.d;
676 if(ml == H)
677 error(exModule);
678 if(ml->prog == nil)
679 error(exSpawn);
680 p = newprog(currun(), ml);
681 o = W(m);
682 if(o >= 0)
683 p->R.PC = ml->links[o].u.pc;
684 else
685 p->R.PC = ml->m->ext[-o-1].u.pc;
686 newstack(p);
687 unframe();
688 }
OP(ret)689 OP(ret)
690 {
691 Frame *f;
692 Modlink *m;
693
694 f = (Frame*)R.FP;
695 R.FP = f->fp;
696 if(R.FP == nil) {
697 R.FP = (uchar*)f;
698 error("");
699 }
700 R.SP = (uchar*)f;
701 R.PC = f->lr;
702 m = f->mr;
703
704 if(f->t == nil)
705 unextend(f);
706 else if (f->t->np)
707 freeptrs(f, f->t);
708
709 if(m != nil) {
710 if(R.M->compiled != m->compiled) {
711 R.IC = 1;
712 R.t = 1;
713 }
714 destroy(R.M);
715 R.M = m;
716 R.MP = m->MP;
717 }
718 }
OP(iload)719 OP(iload)
720 {
721 char *n;
722 Import *ldt;
723 Module *m;
724 Modlink *ml, **mp, *t;
725 Heap *h;
726
727 n = string2c(S(s));
728 m = R.M->m;
729 if(m->rt & HASLDT)
730 ldt = m->ldt[W(m)];
731 else{
732 ldt = nil;
733 error("obsolete dis");
734 }
735
736 if(strcmp(n, "$self") == 0) {
737 m->ref++;
738 ml = linkmod(m, ldt, 0);
739 if(ml != H) {
740 ml->MP = R.M->MP;
741 h = D2H(ml->MP);
742 h->ref++;
743 Setmark(h);
744 }
745 }
746 else {
747 m = readmod(n, lookmod(n), 1);
748 ml = linkmod(m, ldt, 1);
749 }
750
751 mp = R.d;
752 t = *mp;
753 *mp = ml;
754 destroy(t);
755 }
OP(mcall)756 OP(mcall)
757 {
758 Heap *h;
759 Prog *p;
760 Frame *f;
761 Linkpc *l;
762 Modlink *ml;
763 int o;
764
765 ml = *(Modlink**)R.d;
766 if(ml == H)
767 error(exModule);
768 f = T(s);
769 f->lr = R.PC;
770 f->fp = R.FP;
771 f->mr = R.M;
772
773 R.FP = (uchar*)f;
774 R.M = ml;
775 h = D2H(ml);
776 h->ref++;
777
778 o = W(m);
779 if(o >= 0)
780 l = &ml->links[o].u;
781 else
782 l = &ml->m->ext[-o-1].u;
783 if(ml->prog == nil) {
784 l->runt(f);
785 h->ref--;
786 R.M = f->mr;
787 R.SP = R.FP;
788 R.FP = f->fp;
789 if(f->t == nil)
790 unextend(f);
791 else if (f->t->np)
792 freeptrs(f, f->t);
793 p = currun();
794 if(p->kill != nil)
795 error(p->kill);
796 R.t = 0;
797 return;
798 }
799 R.MP = R.M->MP;
800 R.PC = l->pc;
801 R.t = 1;
802
803 if(f->mr->compiled != R.M->compiled)
804 R.IC = 1;
805 }
OP(lena)806 OP(lena)
807 {
808 WORD l;
809 Array *a;
810
811 a = A(s);
812 l = 0;
813 if(a != H)
814 l = a->len;
815 W(d) = l;
816 }
OP(lenl)817 OP(lenl)
818 {
819 WORD l;
820 List *a;
821
822 a = L(s);
823 l = 0;
824 while(a != H) {
825 l++;
826 a = a->tail;
827 }
828 W(d) = l;
829 }
830 static int
cgetb(Channel * c,void * v)831 cgetb(Channel *c, void *v)
832 {
833 Array *a;
834 void *w;
835
836 if((a = c->buf) == H)
837 return 0;
838 if(c->size > 0){
839 w = a->data+c->front*a->t->size;
840 c->front++;
841 if(c->front == c->buf->len)
842 c->front = 0;
843 c->size--;
844 R.s = w;
845 R.m = &c->mid;
846 R.d = v;
847 c->mover();
848 if(a->t->np){
849 freeptrs(w, a->t);
850 initmem(a->t, w);
851 }
852 return 1;
853 }
854 return 0;
855 }
856 static int
cputb(Channel * c,void * v)857 cputb(Channel *c, void *v)
858 {
859 Array *a;
860 WORD len, r;
861
862 if((a = c->buf) == H)
863 return 0;
864 len = c->buf->len;
865 if(c->size < len){
866 r = c->front+c->size;
867 if(r >= len)
868 r -= len;
869 c->size++;
870 R.s = v;
871 R.m = &c->mid;
872 R.d = a->data+r*a->t->size;
873 c->mover();
874 return 1;
875 }
876 return 0;
877 }
878 /*
879 int
880 cqsize(Progq *q)
881 {
882 int n;
883
884 n = 0;
885 for( ; q != nil; q = q->next)
886 if(q->prog != nil)
887 n++;
888 return n;
889 }
890 */
891 void
cqadd(Progq ** q,Prog * p)892 cqadd(Progq **q, Prog *p)
893 {
894 Progq *n;
895
896 if((*q)->prog == nil){
897 (*q)->prog = p;
898 return;
899 }
900 n = (Progq*)malloc(sizeof(Progq));
901 if(n == nil)
902 error(exNomem);
903 n->prog = p;
904 n->next = nil;
905 for( ; *q != nil; q = &(*q)->next)
906 ;
907 *q = n;
908 }
909 void
cqdel(Progq ** q)910 cqdel(Progq **q)
911 {
912 Progq *f;
913
914 if((*q)->next == nil){
915 (*q)->prog = nil;
916 return;
917 }
918 f = *q;
919 *q = f->next;
920 free(f);
921 }
922 void
cqdelp(Progq ** q,Prog * p)923 cqdelp(Progq **q, Prog *p)
924 {
925 Progq *f;
926
927 if((*q)->next == nil){
928 if((*q)->prog == p)
929 (*q)->prog = nil;
930 return;
931 }
932 for( ; *q != nil; ){
933 if((*q)->prog == p){
934 f = *q;
935 *q = (*q)->next;
936 free(f);
937 }
938 else
939 q = &(*q)->next;
940 }
941 }
OP(isend)942 OP(isend)
943 {
944 Channel *c;
945 Prog *p;
946
947 c = C(d);
948 if(c == H)
949 error(exNilref);
950
951 if((p = c->recv->prog) == nil) {
952 if(c->buf != H && cputb(c, R.s))
953 return;
954 p = delrun(Psend);
955 p->ptr = R.s;
956 p->chan = c; /* for killprog */
957 R.IC = 1;
958 R.t = 1;
959 cqadd(&c->send, p);
960 return;
961 }
962
963 if(c->buf != H && c->size > 0)
964 print("non-empty buffer in isend\n");
965
966 cqdel(&c->recv);
967 if(p->state == Palt)
968 altdone(p->R.s, p, c, 1);
969
970 R.m = &c->mid;
971 R.d = p->ptr;
972 p->ptr = nil;
973 c->mover();
974 addrun(p);
975 R.t = 0;
976 }
OP(irecv)977 OP(irecv)
978 {
979 Channel *c;
980 Prog *p;
981
982 c = C(s);
983 if(c == H)
984 error(exNilref);
985
986 if((p = c->send->prog) == nil) {
987 if(c->buf != H && cgetb(c, R.d))
988 return;
989 p = delrun(Precv);
990 p->ptr = R.d;
991 p->chan = c; /* for killprog */
992 R.IC = 1;
993 R.t = 1;
994 cqadd(&c->recv, p);
995 return;
996 }
997
998 if(c->buf != H && c->size != c->buf->len)
999 print("non-full buffer in irecv\n");
1000
1001 cqdel(&c->send);
1002 if(p->state == Palt)
1003 altdone(p->R.s, p, c, 0);
1004
1005 if(c->buf != H){
1006 cgetb(c, R.d);
1007 cputb(c, p->ptr);
1008 p->ptr = nil;
1009 }
1010 else{
1011 R.m = &c->mid;
1012 R.s = p->ptr;
1013 p->ptr = nil;
1014 c->mover();
1015 }
1016 addrun(p);
1017 R.t = 0;
1018 }
1019 int
csendalt(Channel * c,void * ip,Type * t,int len)1020 csendalt(Channel *c, void *ip, Type *t, int len)
1021 {
1022 REG rsav;
1023
1024 if(c == H)
1025 error(exNilref);
1026
1027 if(c->recv->prog == nil && (c->buf == H || c->size == c->buf->len)){
1028 if(c->buf != H){
1029 print("csendalt failed\n");
1030 freeptrs(ip, t);
1031 return 0;
1032 }
1033 c->buf = H2D(Array*, heaparray(t, len));
1034 }
1035
1036 rsav = R;
1037 R.s = ip;
1038 R.d = &c;
1039 isend();
1040 R = rsav;
1041 freeptrs(ip, t);
1042 return 1;
1043 }
1044
1045 List*
cons(ulong size,List ** lp)1046 cons(ulong size, List **lp)
1047 {
1048 Heap *h;
1049 List *lv, *l;
1050
1051 h = nheap(sizeof(List) + size - sizeof(((List*)0)->data));
1052 h->t = &Tlist;
1053 Tlist.ref++;
1054 l = H2D(List*, h);
1055 l->t = nil;
1056
1057 lv = *lp;
1058 if(lv != H) {
1059 h = D2H(lv);
1060 Setmark(h);
1061 }
1062 l->tail = lv;
1063 *lp = l;
1064 return l;
1065 }
OP(consb)1066 OP(consb)
1067 {
1068 List *l;
1069
1070 l = cons(IBY2WD, R.d);
1071 *(BYTE*)l->data = B(s);
1072 }
OP(consw)1073 OP(consw)
1074 {
1075 List *l;
1076
1077 l = cons(IBY2WD, R.d);
1078 *(WORD*)l->data = W(s);
1079 }
OP(consl)1080 OP(consl)
1081 {
1082 List *l;
1083
1084 l = cons(IBY2LG, R.d);
1085 *(LONG*)l->data = V(s);
1086 }
OP(consp)1087 OP(consp)
1088 {
1089 List *l;
1090 Heap *h;
1091 WORD *sv;
1092
1093 l = cons(IBY2WD, R.d);
1094 sv = P(s);
1095 if(sv != H) {
1096 h = D2H(sv);
1097 h->ref++;
1098 Setmark(h);
1099 }
1100 l->t = &Tptr;
1101 Tptr.ref++;
1102 *(WORD**)l->data = sv;
1103 }
OP(consf)1104 OP(consf)
1105 {
1106 List *l;
1107
1108 l = cons(sizeof(REAL), R.d);
1109 *(REAL*)l->data = F(s);
1110 }
OP(consm)1111 OP(consm)
1112 {
1113 int v;
1114 List *l;
1115
1116 v = W(m);
1117 l = cons(v, R.d);
1118 memmove(l->data, R.s, v);
1119 }
OP(consmp)1120 OP(consmp)
1121 {
1122 List *l;
1123 Type *t;
1124
1125 t = R.M->type[W(m)];
1126 l = cons(t->size, R.d);
1127 incmem(R.s, t);
1128 memmove(l->data, R.s, t->size);
1129 l->t = t;
1130 t->ref++;
1131 }
OP(headb)1132 OP(headb)
1133 {
1134 List *l;
1135
1136 l = L(s);
1137 B(d) = *(BYTE*)l->data;
1138 }
OP(headw)1139 OP(headw)
1140 {
1141 List *l;
1142
1143 l = L(s);
1144 W(d) = *(WORD*)l->data;
1145 }
OP(headl)1146 OP(headl)
1147 {
1148 List *l;
1149
1150 l = L(s);
1151 V(d) = *(LONG*)l->data;
1152 }
OP(headp)1153 OP(headp)
1154 {
1155 List *l;
1156
1157 l = L(s);
1158 R.s = l->data;
1159 movp();
1160 }
OP(headf)1161 OP(headf)
1162 {
1163 List *l;
1164
1165 l = L(s);
1166 F(d) = *(REAL*)l->data;
1167 }
OP(headm)1168 OP(headm)
1169 {
1170 List *l;
1171
1172 l = L(s);
1173 memmove(R.d, l->data, W(m));
1174 }
OP(headmp)1175 OP(headmp)
1176 {
1177 List *l;
1178
1179 l = L(s);
1180 R.s = l->data;
1181 movmp();
1182 }
OP(tail)1183 OP(tail)
1184 {
1185 List *l;
1186
1187 l = L(s);
1188 R.s = &l->tail;
1189 movp();
1190 }
OP(slicea)1191 OP(slicea)
1192 {
1193 Type *t;
1194 Heap *h;
1195 Array *at, *ss, *ds;
1196 int v, n, start;
1197
1198 v = W(m);
1199 start = W(s);
1200 n = v - start;
1201 ds = A(d);
1202
1203 if(ds == H) {
1204 if(n == 0)
1205 return;
1206 error(exNilref);
1207 }
1208 if(n < 0 || (ulong)start > ds->len || (ulong)v > ds->len)
1209 error(exBounds);
1210
1211 t = ds->t;
1212 h = heap(&Tarray);
1213 ss = H2D(Array*, h);
1214 ss->len = n;
1215 ss->data = ds->data + start*t->size;
1216 ss->t = t;
1217 t->ref++;
1218
1219 if(ds->root != H) { /* slicing a slice */
1220 ds = ds->root;
1221 h = D2H(ds);
1222 h->ref++;
1223 at = A(d);
1224 A(d) = ss;
1225 ss->root = ds;
1226 destroy(at);
1227 }
1228 else {
1229 h = D2H(ds);
1230 ss->root = ds;
1231 A(d) = ss;
1232 }
1233 Setmark(h);
1234 }
OP(slicela)1235 OP(slicela)
1236 {
1237 Type *t;
1238 int l, dl;
1239 Array *ss, *ds;
1240 uchar *sp, *dp, *ep;
1241
1242 ss = A(s);
1243 dl = W(m);
1244 ds = A(d);
1245 if(ss == H)
1246 return;
1247 if(ds == H)
1248 error(exNilref);
1249 if(dl < 0 || dl+ss->len > ds->len)
1250 error(exBounds);
1251
1252 t = ds->t;
1253 if(t->np == 0) {
1254 memmove(ds->data+dl*t->size, ss->data, ss->len*t->size);
1255 return;
1256 }
1257 sp = ss->data;
1258 dp = ds->data+dl*t->size;
1259
1260 if(dp > sp) {
1261 l = ss->len * t->size;
1262 sp = ss->data + l;
1263 ep = dp + l;
1264 while(ep > dp) {
1265 ep -= t->size;
1266 sp -= t->size;
1267 incmem(sp, t);
1268 if (t->np)
1269 freeptrs(ep, t);
1270 }
1271 }
1272 else {
1273 ep = dp + ss->len*t->size;
1274 while(dp < ep) {
1275 incmem(sp, t);
1276 if (t->np)
1277 freeptrs(dp, t);
1278 dp += t->size;
1279 sp += t->size;
1280 }
1281 }
1282 memmove(ds->data+dl*t->size, ss->data, ss->len*t->size);
1283 }
OP(alt)1284 OP(alt)
1285 {
1286 R.t = 0;
1287 xecalt(1);
1288 }
OP(nbalt)1289 OP(nbalt)
1290 {
1291 xecalt(0);
1292 }
OP(tcmp)1293 OP(tcmp)
1294 {
1295 void *s, *d;
1296
1297 s = T(s);
1298 d = T(d);
1299 if(s != H && (d == H || D2H(s)->t != D2H(d)->t))
1300 error(exTcheck);
1301 }
OP(eclr)1302 OP(eclr)
1303 {
1304 /* spare slot */
1305 }
OP(badop)1306 OP(badop)
1307 {
1308 error(exOp);
1309 }
OP(iraise)1310 OP(iraise)
1311 {
1312 void *v;
1313 Heap *h;
1314 Prog *p;
1315
1316 p = currun();
1317 v = T(s);
1318 if(v == H)
1319 error(exNilref);
1320 p->exval = v;
1321 h = D2H(v);
1322 h->ref++;
1323 if(h->t == &Tstring)
1324 error(string2c((String*)v));
1325 else
1326 error(string2c(*(String**)v));
1327 }
OP(mulx)1328 OP(mulx)
1329 {
1330 WORD p;
1331 LONG r;
1332
1333 p = Dtmp;
1334 r = (LONG)W(m)*(LONG)W(s);
1335 if(p >= 0)
1336 r <<= p;
1337 else
1338 r >>= (-p);
1339 W(d) = (WORD)r;
1340 }
OP(divx)1341 OP(divx)
1342 {
1343 WORD p;
1344 LONG s;
1345
1346 p = Dtmp;
1347 s = (LONG)W(m);
1348 if(p >= 0)
1349 s <<= p;
1350 else
1351 s >>= (-p);
1352 s /= (LONG)W(s);
1353 W(d) = (WORD)s;
1354 }
OP(cvtxx)1355 OP(cvtxx)
1356 {
1357 WORD p;
1358 LONG r;
1359
1360 p = W(m);
1361 r = (LONG)W(s);
1362 if(p >= 0)
1363 r <<= p;
1364 else
1365 r >>= (-p);
1366 W(d) = (WORD)r;
1367 }
OP(mulx0)1368 OP(mulx0)
1369 {
1370 WORD x, y, p, a;
1371 LONG r;
1372
1373 x = W(m);
1374 y = W(s);
1375 p = Dtmp;
1376 a = Stmp;
1377 if(x == 0 || y == 0){
1378 W(d) = 0;
1379 return;
1380 }
1381 r = (LONG)x*(LONG)y;
1382 if(p >= 0)
1383 r <<= p;
1384 else
1385 r >>= (-p);
1386 r /= (LONG)a;
1387 W(d) = (WORD)r;
1388 }
OP(divx0)1389 OP(divx0)
1390 {
1391 WORD x, y, p, b;
1392 LONG s;
1393
1394 x = W(m);
1395 y = W(s);
1396 p = Dtmp;
1397 b = Stmp;
1398 if(x == 0){
1399 W(d) = 0;
1400 return;
1401 }
1402 s = (LONG)b*(LONG)x;
1403 if(p >= 0)
1404 s <<= p;
1405 else
1406 s >>= (-p);
1407 s /= (LONG)y;
1408 W(d) = (WORD)s;
1409 }
OP(cvtxx0)1410 OP(cvtxx0)
1411 {
1412 WORD x, p, a;
1413 LONG r;
1414
1415 x = W(s);
1416 p = W(m);
1417 a = Stmp;
1418 if(x == 0){
1419 W(d) = 0;
1420 return;
1421 }
1422 r = (LONG)x;
1423 if(p >= 0)
1424 r <<= p;
1425 else
1426 r >>= (-p);
1427 r /= (LONG)a;
1428 W(d) = (WORD)r;
1429 }
OP(mulx1)1430 OP(mulx1)
1431 {
1432 WORD x, y, p, a, v;
1433 int vnz, wnz;
1434 LONG w, r;
1435
1436 x = W(m);
1437 y = W(s);
1438 p = Dtmp;
1439 a = Stmp;
1440 if(x == 0 || y == 0){
1441 W(d) = 0;
1442 return;
1443 }
1444 vnz = p&2;
1445 wnz = p&1;
1446 p >>= 2;
1447 v = 0;
1448 w = 0;
1449 if(vnz){
1450 v = a-1;
1451 if(x >= 0 && y < 0 || x < 0 && y >= 0)
1452 v = -v;
1453 }
1454 if(wnz){
1455 if((!vnz && (x > 0 && y < 0 || x < 0 && y > 0)) ||
1456 (vnz && (x > 0 && y > 0 || x < 0 && y < 0)))
1457 w = ((LONG)1<<(-p)) - 1;
1458 }
1459 r = (LONG)x*(LONG)y + w;
1460 if(p >= 0)
1461 r <<= p;
1462 else
1463 r >>= (-p);
1464 r += (LONG)v;
1465 r /= (LONG)a;
1466 W(d) = (WORD)r;
1467 }
OP(divx1)1468 OP(divx1)
1469 {
1470 WORD x, y, p, b, v;
1471 int vnz, wnz;
1472 LONG w, s;
1473
1474 x = W(m);
1475 y = W(s);
1476 p = Dtmp;
1477 b = Stmp;
1478 if(x == 0){
1479 W(d) = 0;
1480 return;
1481 }
1482 vnz = p&2;
1483 wnz = p&1;
1484 p >>= 2;
1485 v = 0;
1486 w = 0;
1487 if(vnz){
1488 v = 1;
1489 if(x >= 0 && y < 0 || x < 0 && y >= 0)
1490 v = -v;
1491 }
1492 if(wnz){
1493 if(x <= 0)
1494 w = ((LONG)1<<(-p)) - 1;
1495 }
1496 s = (LONG)b*(LONG)x + w;
1497 if(p >= 0)
1498 s <<= p;
1499 else
1500 s >>= (-p);
1501 s /= (LONG)y;
1502 W(d) = (WORD)s + v;
1503 }
OP(cvtxx1)1504 OP(cvtxx1)
1505 {
1506 WORD x, p, a, v;
1507 int vnz, wnz;
1508 LONG w, r;
1509
1510 x = W(s);
1511 p = W(m);
1512 a = Stmp;
1513 if(x == 0){
1514 W(d) = 0;
1515 return;
1516 }
1517 vnz = p&2;
1518 wnz = p&1;
1519 p >>= 2;
1520 v = 0;
1521 w = 0;
1522 if(vnz){
1523 v = a-1;
1524 if(x < 0)
1525 v = -v;
1526 }
1527 if(wnz){
1528 if(!vnz && x < 0 || vnz && x > 0)
1529 w = ((LONG)1<<(-p)) - 1;
1530 }
1531 r = (LONG)x + w;
1532 if(p >= 0)
1533 r <<= p;
1534 else
1535 r >>= (-p);
1536 r += (LONG)v;
1537 r /= (LONG)a;
1538 W(d) = (WORD)r;
1539 }
1540 /*
1541 OP(cvtxx)
1542 {
1543 REAL v;
1544
1545 v = (REAL)W(s)*F(m);
1546 v = v < 0 ? v-0.5: v+0.5;
1547 W(d) = (WORD)v;
1548 }
1549 */
OP(cvtfx)1550 OP(cvtfx)
1551 {
1552 REAL v;
1553
1554 v = F(s)*F(m);
1555 v = v < 0 ? v-0.5: v+0.5;
1556 W(d) = (WORD)v;
1557 }
OP(cvtxf)1558 OP(cvtxf)
1559 {
1560 F(d) = (REAL)W(s)*F(m);
1561 }
1562
OP(self)1563 OP(self)
1564 {
1565 Modlink *ml, **mp, *t;
1566 Heap *h;
1567
1568 ml = R.M;
1569 h = D2H(ml);
1570 h->ref++;
1571 Setmark(h);
1572 mp = R.d;
1573 t = *mp;
1574 *mp = ml;
1575 destroy(t);
1576 }
1577
1578 void
destroystack(REG * reg)1579 destroystack(REG *reg)
1580 {
1581 Type *t;
1582 Frame *f, *fp;
1583 Modlink *m;
1584 Stkext *sx;
1585 uchar *ex;
1586
1587 ex = reg->EX;
1588 reg->EX = nil;
1589 while(ex != nil) {
1590 sx = (Stkext*)ex;
1591 fp = sx->reg.tos.fr;
1592 do {
1593 f = (Frame*)reg->FP;
1594 if(f == nil)
1595 break;
1596 reg->FP = f->fp;
1597 t = f->t;
1598 if(t == nil)
1599 t = sx->reg.TR;
1600 m = f->mr;
1601 if (t->np)
1602 freeptrs(f, t);
1603 if(m != nil) {
1604 destroy(reg->M);
1605 reg->M = m;
1606 }
1607 } while(f != fp);
1608 ex = sx->reg.EX;
1609 free(sx);
1610 }
1611 destroy(reg->M);
1612 reg->M = H; /* for devprof */
1613 }
1614
1615 Prog*
isave(void)1616 isave(void)
1617 {
1618 Prog *p;
1619
1620 p = delrun(Prelease);
1621 p->R = R;
1622 return p;
1623 }
1624
1625 void
irestore(Prog * p)1626 irestore(Prog *p)
1627 {
1628 R = p->R;
1629 R.IC = 1;
1630 }
1631
1632 void
movtmp(void)1633 movtmp(void) /* Used by send & receive */
1634 {
1635 Type *t;
1636
1637 t = (Type*)W(m);
1638
1639 incmem(R.s, t);
1640 if (t->np)
1641 freeptrs(R.d, t);
1642 memmove(R.d, R.s, t->size);
1643 }
1644
1645 extern OP(cvtca);
1646 extern OP(cvtac);
1647 extern OP(cvtwc);
1648 extern OP(cvtcw);
1649 extern OP(cvtfc);
1650 extern OP(cvtcf);
1651 extern OP(insc);
1652 extern OP(indc);
1653 extern OP(addc);
1654 extern OP(lenc);
1655 extern OP(slicec);
1656 extern OP(cvtlc);
1657
1658 #include "optab.h"
1659
1660 void
opinit(void)1661 opinit(void)
1662 {
1663 int i;
1664
1665 for(i = 0; i < 256; i++)
1666 if(optab[i] == nil)
1667 optab[i] = badop;
1668 }
1669
1670 void
xec(Prog * p)1671 xec(Prog *p)
1672 {
1673 int op;
1674
1675 R = p->R;
1676 R.MP = R.M->MP;
1677 R.IC = p->quanta;
1678
1679 if(p->kill != nil) {
1680 char *m;
1681 m = p->kill;
1682 p->kill = nil;
1683 error(m);
1684 }
1685
1686 // print("%lux %lux %lux %lux %lux\n", (ulong)&R, R.xpc, R.FP, R.MP, R.PC);
1687
1688 if(R.M->compiled)
1689 comvec();
1690 else do {
1691 dec[R.PC->add]();
1692 op = R.PC->op;
1693 R.PC++;
1694 optab[op]();
1695 } while(--R.IC != 0);
1696
1697 p->R = R;
1698 }
1699