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 30 OP(runt) {} 31 OP(negf) { F(d) = -F(s); } 32 OP(jmp) { JMP(d); } 33 OP(movpc){ T(d) = &R.M->prog[W(s)]; } 34 OP(movm) { memmove(R.d, R.s, W(m)); } 35 OP(lea) { W(d) = (WORD)R.s; } 36 OP(movb) { B(d) = B(s); } 37 OP(movw) { W(d) = W(s); } 38 OP(movf) { F(d) = F(s); } 39 OP(movl) { V(d) = V(s); } 40 OP(cvtbw){ W(d) = B(s); } 41 OP(cvtwb){ B(d) = W(s); } 42 OP(cvtrf){ F(d) = SR(s); } 43 OP(cvtfr){ SR(d) = F(s); } 44 OP(cvtws){ SH(d) = W(s); } 45 OP(cvtsw){ W(d) = SH(s); } 46 OP(cvtwf){ F(d) = W(s); } 47 OP(addb) { B(d) = B(m) + B(s); } 48 OP(addw) { W(d) = W(m) + W(s); } 49 OP(addl) { V(d) = V(m) + V(s); } 50 OP(addf) { F(d) = F(m) + F(s); } 51 OP(subb) { B(d) = B(m) - B(s); } 52 OP(subw) { W(d) = W(m) - W(s); } 53 OP(subl) { V(d) = V(m) - V(s); } 54 OP(subf) { F(d) = F(m) - F(s); } 55 OP(divb) { B(d) = B(m) / B(s); } 56 OP(divw) { W(d) = W(m) / W(s); } 57 OP(divl) { V(d) = V(m) / V(s); } 58 OP(divf) { F(d) = F(m) / F(s); } 59 OP(modb) { B(d) = B(m) % B(s); } 60 OP(modw) { W(d) = W(m) % W(s); } 61 OP(modl) { V(d) = V(m) % V(s); } 62 OP(mulb) { B(d) = B(m) * B(s); } 63 OP(mulw) { W(d) = W(m) * W(s); } 64 OP(mull) { V(d) = V(m) * V(s); } 65 OP(mulf) { F(d) = F(m) * F(s); } 66 OP(andb) { B(d) = B(m) & B(s); } 67 OP(andw) { W(d) = W(m) & W(s); } 68 OP(andl) { V(d) = V(m) & V(s); } 69 OP(xorb) { B(d) = B(m) ^ B(s); } 70 OP(xorw) { W(d) = W(m) ^ W(s); } 71 OP(xorl) { V(d) = V(m) ^ V(s); } 72 OP(orb) { B(d) = B(m) | B(s); } 73 OP(orw) { W(d) = W(m) | W(s); } 74 OP(orl) { V(d) = V(m) | V(s); } 75 OP(shlb) { B(d) = B(m) << W(s); } 76 OP(shlw) { W(d) = W(m) << W(s); } 77 OP(shll) { V(d) = V(m) << W(s); } 78 OP(shrb) { B(d) = B(m) >> W(s); } 79 OP(shrw) { W(d) = W(m) >> W(s); } 80 OP(shrl) { V(d) = V(m) >> W(s); } 81 OP(lsrw) { W(d) = UW(m) >> W(s); } 82 OP(lsrl) { V(d) = UV(m) >> W(s); } 83 OP(beqb) { if(B(s) == B(m)) JMP(d); } 84 OP(bneb) { if(B(s) != B(m)) JMP(d); } 85 OP(bltb) { if(B(s) < B(m)) JMP(d); } 86 OP(bleb) { if(B(s) <= B(m)) JMP(d); } 87 OP(bgtb) { if(B(s) > B(m)) JMP(d); } 88 OP(bgeb) { if(B(s) >= B(m)) JMP(d); } 89 OP(beqw) { if(W(s) == W(m)) JMP(d); } 90 OP(bnew) { if(W(s) != W(m)) JMP(d); } 91 OP(bltw) { if(W(s) < W(m)) JMP(d); } 92 OP(blew) { if(W(s) <= W(m)) JMP(d); } 93 OP(bgtw) { if(W(s) > W(m)) JMP(d); } 94 OP(bgew) { if(W(s) >= W(m)) JMP(d); } 95 OP(beql) { if(V(s) == V(m)) JMP(d); } 96 OP(bnel) { if(V(s) != V(m)) JMP(d); } 97 OP(bltl) { if(V(s) < V(m)) JMP(d); } 98 OP(blel) { if(V(s) <= V(m)) JMP(d); } 99 OP(bgtl) { if(V(s) > V(m)) JMP(d); } 100 OP(bgel) { if(V(s) >= V(m)) JMP(d); } 101 OP(beqf) { if(F(s) == F(m)) JMP(d); } 102 OP(bnef) { if(F(s) != F(m)) JMP(d); } 103 OP(bltf) { if(F(s) < F(m)) JMP(d); } 104 OP(blef) { if(F(s) <= F(m)) JMP(d); } 105 OP(bgtf) { if(F(s) > F(m)) JMP(d); } 106 OP(bgef) { if(F(s) >= F(m)) JMP(d); } 107 OP(beqc) { if(stringcmp(S(s), S(m)) == 0) JMP(d); } 108 OP(bnec) { if(stringcmp(S(s), S(m)) != 0) JMP(d); } 109 OP(bltc) { if(stringcmp(S(s), S(m)) < 0) JMP(d); } 110 OP(blec) { if(stringcmp(S(s), S(m)) <= 0) JMP(d); } 111 OP(bgtc) { if(stringcmp(S(s), S(m)) > 0) JMP(d); } 112 OP(bgec) { if(stringcmp(S(s), S(m)) >= 0) JMP(d); } 113 OP(iexit){ error(""); } 114 OP(cvtwl){ V(d) = W(s); } 115 OP(cvtlw){ W(d) = V(s); } 116 OP(cvtlf){ F(d) = V(s); } 117 OP(cvtfl) 118 { 119 REAL f; 120 121 f = F(s); 122 V(d) = f < 0 ? f - .5 : f + .5; 123 } 124 OP(cvtfw) 125 { 126 REAL f; 127 128 f = F(s); 129 W(d) = f < 0 ? f - .5 : f + .5; 130 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 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 } 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 } 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* 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* 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 } 497 OP(newcl) { newc(&Tlong, movl); } 498 OP(newcb) { newc(&Tbyte, movb); } 499 OP(newcw) { newc(&Tword, movw); } 500 OP(newcf) { newc(&Treal, movf); } 501 OP(newcp) { newc(&Tptr, movp); } 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 } 515 OP(newcmp) 516 { 517 newc(R.M->type[W(s)], movtmp); 518 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 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 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 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 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 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 } 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 } 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 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* 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 } 1066 OP(consb) 1067 { 1068 List *l; 1069 1070 l = cons(IBY2WD, R.d); 1071 *(BYTE*)l->data = B(s); 1072 } 1073 OP(consw) 1074 { 1075 List *l; 1076 1077 l = cons(IBY2WD, R.d); 1078 *(WORD*)l->data = W(s); 1079 } 1080 OP(consl) 1081 { 1082 List *l; 1083 1084 l = cons(IBY2LG, R.d); 1085 *(LONG*)l->data = V(s); 1086 } 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 } 1104 OP(consf) 1105 { 1106 List *l; 1107 1108 l = cons(sizeof(REAL), R.d); 1109 *(REAL*)l->data = F(s); 1110 } 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 } 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 } 1132 OP(headb) 1133 { 1134 List *l; 1135 1136 l = L(s); 1137 B(d) = *(BYTE*)l->data; 1138 } 1139 OP(headw) 1140 { 1141 List *l; 1142 1143 l = L(s); 1144 W(d) = *(WORD*)l->data; 1145 } 1146 OP(headl) 1147 { 1148 List *l; 1149 1150 l = L(s); 1151 V(d) = *(LONG*)l->data; 1152 } 1153 OP(headp) 1154 { 1155 List *l; 1156 1157 l = L(s); 1158 R.s = l->data; 1159 movp(); 1160 } 1161 OP(headf) 1162 { 1163 List *l; 1164 1165 l = L(s); 1166 F(d) = *(REAL*)l->data; 1167 } 1168 OP(headm) 1169 { 1170 List *l; 1171 1172 l = L(s); 1173 memmove(R.d, l->data, W(m)); 1174 } 1175 OP(headmp) 1176 { 1177 List *l; 1178 1179 l = L(s); 1180 R.s = l->data; 1181 movmp(); 1182 } 1183 OP(tail) 1184 { 1185 List *l; 1186 1187 l = L(s); 1188 R.s = &l->tail; 1189 movp(); 1190 } 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 } 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 } 1284 OP(alt) 1285 { 1286 R.t = 0; 1287 xecalt(1); 1288 } 1289 OP(nbalt) 1290 { 1291 xecalt(0); 1292 } 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 } 1302 OP(eclr) 1303 { 1304 /* spare slot */ 1305 } 1306 OP(badop) 1307 { 1308 error(exOp); 1309 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 } 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 */ 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 } 1558 OP(cvtxf) 1559 { 1560 F(d) = (REAL)W(s)*F(m); 1561 } 1562 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 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* 1616 isave(void) 1617 { 1618 Prog *p; 1619 1620 p = delrun(Prelease); 1621 p->R = R; 1622 return p; 1623 } 1624 1625 void 1626 irestore(Prog *p) 1627 { 1628 R = p->R; 1629 R.IC = 1; 1630 } 1631 1632 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 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 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