1 #ifndef lint 2 static char sccsid[] = "@(#)local2.c 1.11 (Berkeley) 12/10/87"; 3 #endif 4 5 # include "pass2.h" 6 # include <ctype.h> 7 8 # define putstr(s) fputs((s), stdout) 9 # define ISCHAR(p) (p->in.type == UCHAR || p->in.type == CHAR) 10 11 # ifdef FORT 12 int ftlab1, ftlab2; 13 # endif 14 /* a lot of the machine dependent parts of the second pass */ 15 16 # define BITMASK(n) ((1L<<n)-1) 17 18 # ifndef ONEPASS 19 where(c){ 20 fprintf( stderr, "%s, line %d: ", filename, lineno ); 21 } 22 # endif 23 24 lineid( l, fn ) char *fn; { 25 /* identify line l and file fn */ 26 printf( "# line %d, file %s\n", l, fn ); 27 } 28 29 int ent_mask; 30 31 eobl2(){ 32 register OFFSZ spoff; /* offset from stack pointer */ 33 #ifndef FORT 34 extern int ftlab1, ftlab2; 35 #endif 36 37 spoff = maxoff; 38 spoff /= SZCHAR; 39 SETOFF(spoff,4); 40 #ifdef FORT 41 #ifndef FLEXNAMES 42 printf( " .set .F%d,%d\n", ftnno, spoff ); 43 #else 44 /* SHOULD BE L%d ... ftnno but must change pc/f77 */ 45 printf( " .set LF%d,%d\n", ftnno, spoff ); 46 #endif 47 printf( " .set LWM%d,0x%x\n", ftnno, ent_mask&0x1ffc|0x1000); 48 #else 49 printf( " .set L%d,0x%x\n", ftnno, ent_mask&0x1ffc); 50 printf( "L%d:\n", ftlab1); 51 if( maxoff > AUTOINIT ) 52 printf( " subl3 $%d,fp,sp\n", spoff); 53 printf( " jbr L%d\n", ftlab2); 54 #endif 55 ent_mask = 0; 56 maxargs = -1; 57 } 58 59 struct hoptab { int opmask; char * opstring; } ioptab[] = { 60 61 PLUS, "add", 62 MINUS, "sub", 63 MUL, "mul", 64 DIV, "div", 65 MOD, "div", 66 OR, "or", 67 ER, "xor", 68 AND, "and", 69 -1, "" }; 70 71 hopcode( f, o ){ 72 /* output the appropriate string from the above table */ 73 74 register struct hoptab *q; 75 76 if(asgop(o)) 77 o = NOASG o; 78 for( q = ioptab; q->opmask>=0; ++q ){ 79 if( q->opmask == o ){ 80 if(f == 'E') 81 printf( "e%s", q->opstring); 82 else 83 printf( "%s%c", q->opstring, tolower(f)); 84 return; 85 } 86 } 87 cerror( "no hoptab for %s", opst[o] ); 88 } 89 90 char * 91 rnames[] = { /* keyed to register number tokens */ 92 93 "r0", "r1", 94 "r2", "r3", "r4", "r5", 95 "r6", "r7", "r8", "r9", "r10", "r11", 96 "r12", "fp", "sp", "pc", 97 }; 98 99 /* output register name and update entry mask */ 100 char * 101 rname(r) 102 register int r; 103 { 104 105 ent_mask |= 1<<r; 106 return(rnames[r]); 107 } 108 109 int rstatus[] = { 110 SAREG|STAREG, SAREG|STAREG, 111 SAREG|STAREG, SAREG|STAREG, SAREG|STAREG, SAREG|STAREG, 112 SAREG, SAREG, SAREG, SAREG, SAREG, SAREG, 113 SAREG, SAREG, SAREG, SAREG, 114 }; 115 116 tlen(p) NODE *p; 117 { 118 switch(p->in.type) { 119 case CHAR: 120 case UCHAR: 121 return(1); 122 123 case SHORT: 124 case USHORT: 125 return(2); 126 127 case DOUBLE: 128 return(8); 129 130 default: 131 return(4); 132 } 133 } 134 135 anyfloat(p, q) 136 NODE *p, *q; 137 { 138 register TWORD tp, tq; 139 140 tp = p->in.type; 141 tq = q->in.type; 142 return (tp == FLOAT || tp == DOUBLE || tq == FLOAT || tq == DOUBLE); 143 } 144 145 prtype(n) NODE *n; 146 { 147 switch (n->in.type) 148 { 149 150 case DOUBLE: 151 putchar('d'); 152 return; 153 154 case FLOAT: 155 putchar('f'); 156 return; 157 158 case INT: 159 case UNSIGNED: 160 putchar('l'); 161 return; 162 163 case SHORT: 164 case USHORT: 165 putchar('w'); 166 return; 167 168 case CHAR: 169 case UCHAR: 170 putchar('b'); 171 return; 172 173 default: 174 if ( !ISPTR( n->in.type ) ) cerror("zzzcode- bad type"); 175 else { 176 putchar('l'); 177 return; 178 } 179 } 180 } 181 182 zzzcode( p, c ) register NODE *p; { 183 register int m; 184 int val; 185 switch( c ){ 186 187 case 'N': /* logical ops, turned into 0-1 */ 188 /* use register given by register 1 */ 189 cbgen( 0, m=getlab(), 'I' ); 190 deflab( p->bn.label ); 191 printf( " clrl %s\n", rname(getlr( p, '1' )->tn.rval) ); 192 deflab( m ); 193 return; 194 195 case 'P': 196 cbgen( p->in.op, p->bn.label, c ); 197 return; 198 199 case 'A': /* assignment and load (integer only) */ 200 { 201 register NODE *l, *r; 202 203 if (xdebug) eprint(p, 0, &val, &val); 204 r = getlr(p, 'R'); 205 if (optype(p->in.op) == LTYPE || p->in.op == UNARY MUL) { 206 l = resc; 207 l->in.type = INT; 208 } else 209 l = getlr(p, 'L'); 210 if(r->in.type==FLOAT || r->in.type==DOUBLE 211 || l->in.type==FLOAT || l->in.type==DOUBLE) 212 cerror("float in ZA"); 213 if (r->in.op == ICON) 214 if(r->in.name[0] == '\0') { 215 if (r->tn.lval == 0) { 216 putstr("clr"); 217 prtype(l); 218 putchar('\t'); 219 adrput(l); 220 return; 221 } 222 if (r->tn.lval < 0 && r->tn.lval >= -63) { 223 putstr("mneg"); 224 prtype(l); 225 r->tn.lval = -r->tn.lval; 226 goto ops; 227 } 228 #ifdef MOVAFASTER 229 } else { 230 putstr("movab\t"); 231 acon(r); 232 putchar(','); 233 adrput(l); 234 return; 235 #endif MOVAFASTER 236 } 237 238 if (l->in.op == REG) { 239 if( tlen(l) < tlen(r) ) { 240 putstr(!ISUNSIGNED(l->in.type)? 241 "cvt": "movz"); 242 prtype(l); 243 putchar('l'); 244 goto ops; 245 } else 246 l->in.type = INT; 247 } 248 if (tlen(l) == tlen(r)) { 249 putstr("mov"); 250 prtype(l); 251 goto ops; 252 } else if (tlen(l) > tlen(r) && ISUNSIGNED(r->in.type)) 253 putstr("movz"); 254 else 255 putstr("cvt"); 256 prtype(r); 257 prtype(l); 258 ops: 259 putchar('\t'); 260 adrput(r); 261 putchar(','); 262 adrput(l); 263 return; 264 } 265 266 case 'B': /* get oreg value in temp register for shift */ 267 { 268 register NODE *r; 269 if (xdebug) eprint(p, 0, &val, &val); 270 r = p->in.right; 271 if( tlen(r) == sizeof(int) && r->in.type != FLOAT ) 272 putstr("movl"); 273 else { 274 putstr(ISUNSIGNED(r->in.type) ? "movz" : "cvt"); 275 prtype(r); 276 putchar('l'); 277 } 278 return; 279 } 280 281 case 'C': /* num bytes pushed on arg stack */ 282 { 283 extern int gc_numbytes; 284 extern int xdebug; 285 286 if (xdebug) printf("->%d<-",gc_numbytes); 287 288 printf("call%c $%d", 289 (p->in.left->in.op==ICON && gc_numbytes<60)?'f':'s', 290 gc_numbytes+4); 291 /* dont change to double (here's the only place to catch it) */ 292 if(p->in.type == FLOAT) 293 rtyflg = 1; 294 return; 295 } 296 297 case 'D': /* INCR and DECR */ 298 zzzcode(p->in.left, 'A'); 299 putstr("\n "); 300 301 case 'E': /* INCR and DECR, FOREFF */ 302 if (p->in.right->tn.lval == 1) 303 { 304 putstr(p->in.op == INCR ? "inc" : "dec"); 305 prtype(p->in.left); 306 putchar('\t'); 307 adrput(p->in.left); 308 return; 309 } 310 putstr(p->in.op == INCR ? "add" : "sub"); 311 prtype(p->in.left); 312 putstr("2 "); 313 adrput(p->in.right); 314 putchar(','); 315 adrput(p->in.left); 316 return; 317 318 case 'F': /* masked constant for fields */ 319 printf(ACONFMT, (p->in.right->tn.lval&((1<<fldsz)-1))<<fldshf); 320 return; 321 322 case 'H': /* opcode for shift */ 323 if(p->in.op == LS || p->in.op == ASG LS) 324 putstr("shll"); 325 else if(ISUNSIGNED(p->in.left->in.type)) 326 putstr("shrl"); 327 else 328 putstr("shar"); 329 return; 330 331 case 'L': /* type of left operand */ 332 case 'R': /* type of right operand */ 333 { 334 register NODE *n; 335 extern int xdebug; 336 337 n = getlr ( p, c); 338 if (xdebug) printf("->%d<-", n->in.type); 339 340 prtype(n); 341 return; 342 } 343 344 case 'M': { /* initiate ediv for mod and unsigned div */ 345 register char *r; 346 m = getlr(p, '1')->tn.rval; 347 r = rname(m); 348 printf("\tclrl\t%s\n\tmovl\t", r); 349 adrput(p->in.left); 350 printf(",%s\n", rname(m+1)); 351 if(!ISUNSIGNED(p->in.type)) { /* should be MOD */ 352 m = getlab(); 353 printf("\tjgeq\tL%d\n\tmnegl\t$1,%s\n", m, r); 354 deflab(m); 355 } 356 return; 357 } 358 359 case 'T': { /* rounded structure length for arguments */ 360 int size = p->stn.stsize; 361 SETOFF( size, 4); 362 printf("movab -%d(sp),sp", size); 363 return; 364 } 365 366 case 'S': /* structure assignment */ 367 stasg(p); 368 break; 369 370 case 'X': /* multiplication for short and char */ 371 if (ISUNSIGNED(p->in.left->in.type)) 372 printf("\tmovz"); 373 else 374 printf("\tcvt"); 375 zzzcode(p, 'L'); 376 printf("l\t"); 377 adrput(p->in.left); 378 printf(","); 379 adrput(&resc[0]); 380 printf("\n"); 381 if (ISUNSIGNED(p->in.right->in.type)) 382 printf("\tmovz"); 383 else 384 printf("\tcvt"); 385 zzzcode(p, 'R'); 386 printf("l\t"); 387 adrput(p->in.right); 388 printf(","); 389 adrput(&resc[1]); 390 printf("\n"); 391 return; 392 393 case 'U': /* SCONV */ 394 case 'V': /* SCONV with FORCC */ 395 sconv(p, c == 'V'); 396 break; 397 398 case 'Z': 399 p = p->in.right; 400 switch (p->in.type) { 401 case SHORT: { 402 short w = p->tn.lval; 403 p->tn.lval = w; 404 break; 405 } 406 case CHAR: { 407 char c = p->tn.lval; 408 p->tn.lval = c; 409 break; 410 } 411 } 412 printf("$%d", p->tn.lval); 413 break; 414 415 default: 416 cerror( "illegal zzzcode" ); 417 } 418 } 419 420 #define MOVB(dst, src, off) { \ 421 putstr("\tmovb\t"); upput(src, off); putchar(','); \ 422 upput(dst, off); putchar('\n'); \ 423 } 424 #define MOVW(dst, src, off) { \ 425 putstr("\tmovw\t"); upput(src, off); putchar(','); \ 426 upput(dst, off); putchar('\n'); \ 427 } 428 #define MOVL(dst, src, off) { \ 429 putstr("\tmovl\t"); upput(src, off); putchar(','); \ 430 upput(dst, off); putchar('\n'); \ 431 } 432 /* 433 * Generate code for a structure assignment. 434 */ 435 stasg(p) 436 register NODE *p; 437 { 438 register NODE *l, *r; 439 register int size; 440 441 switch (p->in.op) { 442 case STASG: /* regular assignment */ 443 l = p->in.left; 444 r = p->in.right; 445 break; 446 case STARG: /* place arg on the stack */ 447 l = getlr(p, '3'); 448 r = p->in.left; 449 break; 450 default: 451 cerror("STASG bad"); 452 /*NOTREACHED*/ 453 } 454 /* 455 * Pun source for use in code generation. 456 */ 457 switch (r->in.op) { 458 case ICON: 459 r->in.op = NAME; 460 break; 461 case REG: 462 r->in.op = OREG; 463 break; 464 default: 465 cerror( "STASG-r" ); 466 /*NOTREACHED*/ 467 } 468 size = p->stn.stsize; 469 if (size <= 0 || size > 65535) 470 cerror("structure size out of range"); 471 /* 472 * Generate optimized code based on structure size 473 * and alignment properties.... 474 */ 475 switch (size) { 476 477 case 1: 478 putstr("\tmovb\t"); 479 optimized: 480 adrput(r); 481 putchar(','); 482 adrput(l); 483 putchar('\n'); 484 break; 485 486 case 2: 487 if (p->stn.stalign != 2) { 488 MOVB(l, r, SZCHAR); 489 putstr("\tmovb\t"); 490 } else 491 putstr("\tmovw\t"); 492 goto optimized; 493 494 case 4: 495 if (p->stn.stalign != 4) { 496 if (p->stn.stalign != 2) { 497 MOVB(l, r, 3*SZCHAR); 498 MOVB(l, r, 2*SZCHAR); 499 MOVB(l, r, 1*SZCHAR); 500 putstr("\tmovb\t"); 501 } else { 502 MOVW(l, r, SZSHORT); 503 putstr("\tmovw\t"); 504 } 505 } else 506 putstr("\tmovl\t"); 507 goto optimized; 508 509 case 6: 510 if (p->stn.stalign != 2) 511 goto movblk; 512 MOVW(l, r, 2*SZSHORT); 513 MOVW(l, r, 1*SZSHORT); 514 putstr("\tmovw\t"); 515 goto optimized; 516 517 case 8: 518 if (p->stn.stalign == 4) { 519 MOVL(l, r, SZLONG); 520 putstr("\tmovl\t"); 521 goto optimized; 522 } 523 /* fall thru...*/ 524 525 default: 526 movblk: 527 /* 528 * Can we ever get a register conflict with R1 here? 529 */ 530 putstr("\tmovab\t"); 531 adrput(l); 532 putstr(",r1\n\tmovab\t"); 533 adrput(r); 534 printf(",r0\n\tmovl\t$%d,r2\n\tmovblk\n", size); 535 rname(R2); 536 break; 537 } 538 /* 539 * Reverse above pun for reclaim. 540 */ 541 if (r->in.op == NAME) 542 r->in.op = ICON; 543 else if (r->in.op == OREG) 544 r->in.op = REG; 545 } 546 547 /* 548 * Output the address of the second item in the 549 * pair pointed to by p. 550 */ 551 upput(p, size) 552 register NODE *p; 553 { 554 CONSZ save; 555 556 if (p->in.op == FLD) 557 p = p->in.left; 558 switch (p->in.op) { 559 560 case NAME: 561 case OREG: 562 save = p->tn.lval; 563 p->tn.lval += size/SZCHAR; 564 adrput(p); 565 p->tn.lval = save; 566 break; 567 568 case REG: 569 if (size == SZLONG) { 570 putstr(rname(p->tn.rval+1)); 571 break; 572 } 573 /* fall thru... */ 574 575 default: 576 cerror("illegal upper address op %s size %d", 577 opst[p->tn.op], size); 578 /*NOTREACHED*/ 579 } 580 } 581 582 #ifdef old 583 /* 584 * Generate code for storage conversions. 585 */ 586 sconv(p, forcc) 587 NODE *p; 588 { 589 register NODE *l, *r; 590 register wfrom, wto; 591 int oltype; 592 593 l = getlr(p, '1'); 594 oltype = l->in.type, l->in.type = r->in.type; 595 r = getlr(p, 'L'); 596 wfrom = tlen(r), wto = tlen(l); 597 if (wfrom == wto) /* e.g. int -> unsigned */ 598 goto done; 599 /* 600 * Conversion in registers requires care 601 * as cvt and movz instruction don't work 602 * as expected (they end up as plain mov's). 603 */ 604 if (l->in.op == REG && r->in.op == REG) { 605 if ((wfrom < wto && ISUNSIGNED(r->in.type)) || 606 (wto < wfrom && ISUNSIGNED(l->in.type))) { 607 /* unsigned, mask */ 608 if (r->tn.rval != l->tn.rval) { 609 printf("\tandl3\t$%d,", (1<<(wto*SZCHAR))-1); 610 adrput(r); 611 putchar(','); 612 } else 613 printf("\tandl2\t$%d,", (1<<(wto*SZCHAR))-1); 614 adrput(l); 615 } else { /* effect sign-extend */ 616 printf("\tpushl\t"); adrput(r); 617 printf("\n\tcvt"); prtype(l); 618 printf("l\t%d(sp),", sizeof (int) - wto); adrput(l); 619 printf("\n\tmovab\t4(sp),sp"); 620 } 621 /* 622 * If condition codes are required then we must generate a 623 * test of the appropriate type. 624 */ 625 if (forcc) { 626 printf("\n\tcmp"); 627 prtype(l); 628 putchar('\t'); 629 printf("$0,"); 630 adrput(l); 631 } 632 } else { 633 /* 634 * Conversion with at least one parameter in memory. 635 */ 636 if (wfrom < wto) { /* expanding datum */ 637 if (ISUNSIGNED(r->in.type)) { 638 printf("\tmovz"); 639 prtype(r); 640 /* 641 * If target is a register, generate 642 * movz?l so optimizer can compress 643 * argument pushes. 644 */ 645 if (l->in.op == REG) 646 putchar('l'); 647 else 648 prtype(l); 649 } else { 650 printf("\tcvt"); 651 prtype(r), prtype(l); 652 } 653 putchar('\t'); 654 adrput(r); 655 } else { /* shrinking dataum */ 656 int off = wfrom - wto; 657 if (l->in.op == REG) { 658 printf("\tmovz"); 659 prtype(l); 660 putchar('l'); 661 } else { 662 printf("\tcvt"); 663 prtype(l), prtype(r); 664 } 665 putchar('\t'); 666 switch (r->in.op) { 667 case NAME: case OREG: 668 r->tn.lval += off; 669 adrput(r); 670 r->tn.lval -= off; 671 break; 672 case REG: case ICON: case UNARY MUL: 673 adrput(r); 674 break; 675 default: 676 cerror("sconv: bad shrink op"); 677 /*NOTREACHED*/ 678 } 679 } 680 putchar(','); 681 adrput(l); 682 } 683 putchar('\n'); 684 done: 685 l->in.type = oltype; 686 } 687 #else /* new */ 688 /* 689 * Generate code for integral scalar conversions. 690 * Many work-arounds for brain-damaged Tahoe register behavior. 691 */ 692 sconv(p, forcc) 693 NODE *p; 694 int forcc; 695 { 696 register NODE *src, *dst; 697 register NODE *tmp; 698 register int srclen, dstlen; 699 int srctype, dsttype; 700 int val; 701 702 if (p->in.op == ASSIGN) { 703 src = getlr(p, 'R'); 704 dst = getlr(p, 'L'); 705 dstlen = tlen(dst); 706 dsttype = dst->in.type; 707 } else /* if (p->in.op == SCONV || optype(p->in.op) == LTYPE) */ { 708 src = getlr(p, 'L'); 709 dst = getlr(p, '1'); 710 dstlen = tlen(p); 711 dsttype = p->in.type; 712 } 713 714 srclen = tlen(src); 715 srctype = src->in.op == REG ? 716 ISUNSIGNED(src->in.type) ? UNSIGNED : INT : 717 src->in.type; 718 719 if (srclen < dstlen) { 720 if (srctype == CHAR && dsttype == USHORT && dst->in.op == REG) { 721 /* (unsigned short) c; => sign extend to 16 bits */ 722 putstr("\tcvtbl\t"); 723 adrput(src); 724 putstr(",-(sp)\n\tmovzwl\t2(sp),"); 725 adrput(dst); 726 putstr("\n\tmovab\t4(sp),sp"); 727 if (forcc) { 728 /* inverted test */ 729 putstr("\n\tcmpl\t$0,"); 730 adrput(dst); 731 } 732 return; 733 } 734 genconv(ISUNSIGNED(srctype), 735 srclen, dst->in.op == REG ? SZINT/SZCHAR : dstlen, 736 src, dst); 737 return; 738 } 739 740 if (srclen > dstlen && dst->in.op == REG) { 741 if (src->in.op == REG) { 742 if (ISUNSIGNED(dsttype)) { 743 val = (1 << dstlen * SZCHAR) - 1; 744 if (src->tn.rval == dst->tn.rval) 745 /* conversion in place */ 746 printf("\tandl2\t$%#x,", val); 747 else { 748 printf("\tandl3\t$%#x,", val); 749 adrput(src); 750 putchar(','); 751 } 752 adrput(dst); 753 return; 754 } 755 val = SZINT - srclen * SZCHAR; 756 printf("\tshll\t$%d,", val); 757 adrput(src); 758 putchar(','); 759 adrput(dst); 760 printf("\n\tshar\t$%d,", val); 761 adrput(dst); 762 putchar(','); 763 adrput(dst); 764 return; 765 } 766 tmp = talloc(); 767 if ((src->in.op == UNARY MUL && 768 ((src->in.left->in.op == NAME || 769 (src->in.left->in.op == ICON)))) || 770 (src->in.op == OREG && !R2TEST(src->tn.rval))) { 771 /* we can increment src's address & pun it */ 772 *tmp = *src; 773 tmp->tn.lval += srclen - dstlen; 774 } else { 775 /* we must store src's address */ 776 *tmp = *dst; 777 putstr("\tmovab\t"); 778 adrput(src); 779 putchar(','); 780 adrput(tmp); 781 putchar('\n'); 782 tmp->tn.op = OREG; 783 tmp->tn.lval = srclen - dstlen; 784 } 785 genconv(ISUNSIGNED(dsttype), dstlen, SZINT/SZCHAR, tmp, dst); 786 tmp->in.op = FREE; 787 return; 788 } 789 790 genconv(ISUNSIGNED(dsttype), 791 srclen, dst->in.op == REG ? SZINT/SZCHAR : dstlen, 792 src, dst); 793 } 794 795 genconv(usrc, srclen, dstlen, src, dst) 796 int usrc, srclen, dstlen; 797 NODE *src, *dst; 798 { 799 static char convtab[SZINT/SZCHAR + 1] = { 800 '?', 'b', 'w', '?', 'l' 801 }; 802 803 if (srclen != dstlen) { 804 if (usrc && srclen < dstlen) 805 putstr("\tmovz"); 806 else 807 putstr("\tcvt"); 808 putchar(convtab[srclen]); 809 } else 810 putstr("\tmov"); 811 putchar(convtab[dstlen]); 812 putchar('\t'); 813 adrput(src); 814 putchar(','); 815 adrput(dst); 816 } 817 #endif /* new */ 818 819 rmove( rt, rs, t ) TWORD t;{ 820 printf( " movl %s,%s\n", rname(rs), rname(rt) ); 821 if(t==DOUBLE) 822 printf( " movl %s,%s\n", rname(rs+1), rname(rt+1) ); 823 } 824 825 struct respref 826 respref[] = { 827 INTAREG|INTBREG, INTAREG|INTBREG, 828 INAREG|INBREG, INAREG|INBREG|SOREG|STARREG|STARNM|SNAME|SCON, 829 INTEMP, INTEMP, 830 FORARG, FORARG, 831 INTEMP, INTAREG|INAREG|INTBREG|INBREG|SOREG|STARREG|STARNM, 832 0, 0 }; 833 834 setregs(){ /* set up temporary registers */ 835 fregs = 6; /* tbl- 6 free regs on Tahoe (0-5) */ 836 } 837 838 #ifndef szty 839 szty(t) TWORD t;{ /* size, in registers, needed to hold thing of type t */ 840 return(t==DOUBLE ? 2 : 1 ); 841 } 842 #endif 843 844 rewfld( p ) NODE *p; { 845 return(1); 846 } 847 848 callreg(p) NODE *p; { 849 return( R0 ); 850 } 851 852 base( p ) register NODE *p; { 853 register int o = p->in.op; 854 855 if( (o==ICON && p->in.name[0] != '\0')) return( 100 ); /* ie no base reg */ 856 if( o==REG ) return( p->tn.rval ); 857 if( (o==PLUS || o==MINUS) && p->in.left->in.op == REG && p->in.right->in.op==ICON) 858 return( p->in.left->tn.rval ); 859 if( o==OREG && !R2TEST(p->tn.rval) && (p->in.type==INT || p->in.type==UNSIGNED || ISPTR(p->in.type)) ) 860 return( p->tn.rval + 0200*1 ); 861 return( -1 ); 862 } 863 864 offset( p, tyl ) register NODE *p; int tyl; { 865 866 if(tyl > 8) return( -1 ); 867 if( tyl==1 && p->in.op==REG && (p->in.type==INT || p->in.type==UNSIGNED) ) return( p->tn.rval ); 868 if( (p->in.op==LS && p->in.left->in.op==REG && (p->in.left->in.type==INT || p->in.left->in.type==UNSIGNED) && 869 (p->in.right->in.op==ICON && p->in.right->in.name[0]=='\0') 870 && (1<<p->in.right->tn.lval)==tyl)) 871 return( p->in.left->tn.rval ); 872 return( -1 ); 873 } 874 875 makeor2( p, q, b, o) register NODE *p, *q; register int b, o; { 876 register NODE *t; 877 register int i; 878 NODE *f; 879 880 p->in.op = OREG; 881 f = p->in.left; /* have to free this subtree later */ 882 883 /* init base */ 884 switch (q->in.op) { 885 case ICON: 886 case REG: 887 case OREG: 888 t = q; 889 break; 890 891 case MINUS: 892 q->in.right->tn.lval = -q->in.right->tn.lval; 893 case PLUS: 894 t = q->in.right; 895 break; 896 897 case UNARY MUL: 898 t = q->in.left->in.left; 899 break; 900 901 default: 902 cerror("illegal makeor2"); 903 } 904 905 p->tn.lval = t->tn.lval; 906 #ifndef FLEXNAMES 907 for(i=0; i<NCHNAM; ++i) 908 p->in.name[i] = t->in.name[i]; 909 #else 910 p->in.name = t->in.name; 911 #endif 912 913 /* init offset */ 914 p->tn.rval = R2PACK( (b & 0177), o, (b>>7) ); 915 916 tfree(f); 917 return; 918 } 919 920 canaddr( p ) NODE *p; { 921 register int o = p->in.op; 922 923 if( o==NAME || o==REG || o==ICON || o==OREG || (o==UNARY MUL && shumul(p->in.left)) ) return(1); 924 return(0); 925 } 926 927 #ifndef shltype 928 shltype( o, p ) register NODE *p; { 929 return( o== REG || o == NAME || o == ICON || o == OREG || ( o==UNARY MUL && shumul(p->in.left)) ); 930 } 931 #endif 932 933 flshape( p ) NODE *p; { 934 register int o = p->in.op; 935 936 if( o==NAME || o==REG || o==ICON || o==OREG || (o==UNARY MUL && shumul(p->in.left)) ) return(1); 937 return(0); 938 } 939 940 shtemp( p ) register NODE *p; { 941 if( p->in.op == STARG ) p = p->in.left; 942 return( p->in.op==NAME || p->in.op ==ICON || p->in.op == OREG || (p->in.op==UNARY MUL && shumul(p->in.left)) ); 943 } 944 945 shumul( p ) register NODE *p; { 946 register int o; 947 extern int xdebug; 948 949 if (xdebug) { 950 printf("\nshumul:op=%d,lop=%d,rop=%d", p->in.op, p->in.left->in.op, p->in.right->in.op); 951 printf(" prname=%s,plty=%d, prlval=%D\n", p->in.right->in.name, p->in.left->in.type, p->in.right->tn.lval); 952 } 953 954 o = p->in.op; 955 if(( o == NAME || (o == OREG && !R2TEST(p->tn.rval)) || o == ICON ) 956 && p->in.type != PTR+DOUBLE) 957 return( STARNM ); 958 959 return( 0 ); 960 } 961 962 special( p, shape ) register NODE *p; { 963 if( shape==SIREG && p->in.op == OREG && R2TEST(p->tn.rval) ) return(1); 964 else return(0); 965 } 966 967 adrcon( val ) CONSZ val; { 968 printf(ACONFMT, val); 969 } 970 971 conput( p ) register NODE *p; { 972 switch( p->in.op ){ 973 974 case ICON: 975 acon( p ); 976 return; 977 978 case REG: 979 putstr(rname(p->tn.rval)); 980 return; 981 982 default: 983 cerror( "illegal conput" ); 984 } 985 } 986 987 insput( p ) NODE *p; { 988 cerror( "insput" ); 989 } 990 991 adrput( p ) register NODE *p; { 992 register int r; 993 /* output an address, with offsets, from p */ 994 995 if( p->in.op == FLD ){ 996 p = p->in.left; 997 } 998 switch( p->in.op ){ 999 1000 case NAME: 1001 acon( p ); 1002 return; 1003 1004 case ICON: 1005 /* addressable value of the constant */ 1006 putchar('$'); 1007 acon( p ); 1008 return; 1009 1010 case REG: 1011 putstr(rname(p->tn.rval)); 1012 if(p->in.type == DOUBLE) /* for entry mask */ 1013 (void) rname(p->tn.rval+1); 1014 return; 1015 1016 case OREG: 1017 r = p->tn.rval; 1018 if( R2TEST(r) ){ /* double indexing */ 1019 register int flags; 1020 1021 flags = R2UPK3(r); 1022 if( flags & 1 ) putchar('*'); 1023 if( p->tn.lval != 0 || p->in.name[0] != '\0' ) acon(p); 1024 if( R2UPK1(r) != 100) printf( "(%s)", rname(R2UPK1(r)) ); 1025 printf( "[%s]", rname(R2UPK2(r)) ); 1026 return; 1027 } 1028 if( r == FP && p->tn.lval > 0 ){ /* in the argument region */ 1029 if( p->in.name[0] != '\0' ) werror( "bad arg temp" ); 1030 printf( CONFMT, p->tn.lval ); 1031 putstr( "(fp)" ); 1032 return; 1033 } 1034 if( p->tn.lval != 0 || p->in.name[0] != '\0') acon( p ); 1035 printf( "(%s)", rname(p->tn.rval) ); 1036 return; 1037 1038 case UNARY MUL: 1039 /* STARNM or STARREG found */ 1040 if( tshape(p, STARNM) ) { 1041 putchar( '*' ); 1042 adrput( p->in.left); 1043 } 1044 return; 1045 1046 default: 1047 cerror( "illegal address" ); 1048 return; 1049 1050 } 1051 1052 } 1053 1054 acon( p ) register NODE *p; { /* print out a constant */ 1055 1056 if( p->in.name[0] == '\0' ){ 1057 printf( CONFMT, p->tn.lval); 1058 return; 1059 } else { 1060 #ifndef FLEXNAMES 1061 printf( "%.8s", p->in.name ); 1062 #else 1063 putstr(p->in.name); 1064 #endif 1065 if (p->tn.lval != 0) { 1066 putchar('+'); 1067 printf(CONFMT, p->tn.lval); 1068 } 1069 } 1070 } 1071 1072 genscall( p, cookie ) register NODE *p; { 1073 /* structure valued call */ 1074 return( gencall( p, cookie ) ); 1075 } 1076 1077 genfcall( p, cookie ) register NODE *p; { 1078 register NODE *p1; 1079 register int m; 1080 static char *funcops[6] = { 1081 "sin", "cos", "sqrt", "exp", "log", "atan" 1082 }; 1083 1084 /* generate function opcodes */ 1085 if(p->in.op==UNARY FORTCALL && p->in.type==FLOAT && 1086 (p1 = p->in.left)->in.op==ICON && 1087 p1->tn.lval==0 && p1->in.type==INCREF(FTN|FLOAT)) { 1088 #ifdef FLEXNAMES 1089 p1->in.name++; 1090 #else 1091 strcpy(p1->in.name, p1->in.name[1]); 1092 #endif 1093 for(m=0; m<6; m++) 1094 if(!strcmp(p1->in.name, funcops[m])) 1095 break; 1096 if(m >= 6) 1097 uerror("no opcode for fortarn function %s", p1->in.name); 1098 } else 1099 uerror("illegal type of fortarn function"); 1100 p1 = p->in.right; 1101 p->in.op = FORTCALL; 1102 if(!canaddr(p1)) 1103 order( p1, INAREG|INBREG|SOREG|STARREG|STARNM ); 1104 m = match( p, INTAREG|INTBREG ); 1105 return(m != MDONE); 1106 } 1107 1108 /* tbl */ 1109 int gc_numbytes; 1110 /* tbl */ 1111 1112 gencall( p, cookie ) register NODE *p; { 1113 /* generate the call given by p */ 1114 register NODE *p1, *ptemp; 1115 register int temp, temp1; 1116 register int m; 1117 1118 if( p->in.right ) temp = argsize( p->in.right ); 1119 else temp = 0; 1120 1121 if( p->in.op == STCALL || p->in.op == UNARY STCALL ){ 1122 /* set aside room for structure return */ 1123 1124 if( p->stn.stsize > temp ) temp1 = p->stn.stsize; 1125 else temp1 = temp; 1126 } 1127 1128 if( temp > maxargs ) maxargs = temp; 1129 SETOFF(temp1,4); 1130 1131 if( p->in.right ){ /* make temp node, put offset in, and generate args */ 1132 ptemp = talloc(); 1133 ptemp->in.op = OREG; 1134 ptemp->tn.lval = -1; 1135 ptemp->tn.rval = SP; 1136 #ifndef FLEXNAMES 1137 ptemp->in.name[0] = '\0'; 1138 #else 1139 ptemp->in.name = ""; 1140 #endif 1141 ptemp->in.rall = NOPREF; 1142 ptemp->in.su = 0; 1143 genargs( p->in.right, ptemp ); 1144 ptemp->in.op = FREE; 1145 } 1146 1147 p1 = p->in.left; 1148 if( p1->in.op != ICON ){ 1149 if( p1->in.op != REG ){ 1150 if( p1->in.op != OREG || R2TEST(p1->tn.rval) ){ 1151 if( p1->in.op != NAME ){ 1152 order( p1, INAREG ); 1153 } 1154 } 1155 } 1156 } 1157 1158 /* tbl 1159 setup gc_numbytes so reference to ZC works */ 1160 1161 gc_numbytes = temp&(0x3ff); 1162 1163 p->in.op = UNARY CALL; 1164 m = match( p, INTAREG|INTBREG ); 1165 1166 return(m != MDONE); 1167 } 1168 1169 /* tbl */ 1170 char * 1171 ccbranches[] = { 1172 "eql", 1173 "neq", 1174 "leq", 1175 "lss", 1176 "geq", 1177 "gtr", 1178 "lequ", 1179 "lssu", 1180 "gequ", 1181 "gtru", 1182 }; 1183 /* tbl */ 1184 1185 cbgen( o, lab, mode ) { /* printf conditional and unconditional branches */ 1186 1187 if(o != 0 && (o < EQ || o > UGT )) 1188 cerror( "bad conditional branch: %s", opst[o] ); 1189 printf( " j%s L%d\n", 1190 o == 0 ? "br" : ccbranches[o-EQ], lab ); 1191 } 1192 1193 nextcook( p, cookie ) NODE *p; { 1194 /* we have failed to match p with cookie; try another */ 1195 if( cookie == FORREW ) return( 0 ); /* hopeless! */ 1196 if( !(cookie&(INTAREG|INTBREG)) ) return( INTAREG|INTBREG ); 1197 if( !(cookie&INTEMP) && asgop(p->in.op) ) return( INTEMP|INAREG|INTAREG|INTBREG|INBREG ); 1198 return( FORREW ); 1199 } 1200 1201 lastchance( p, cook ) NODE *p; { 1202 /* forget it! */ 1203 return(0); 1204 } 1205 1206 optim2( p ) register NODE *p; { 1207 # ifdef ONEPASS 1208 /* do local tree transformations and optimizations */ 1209 # define RV(p) p->in.right->tn.lval 1210 # define nncon(p) ((p)->in.op == ICON && (p)->in.name[0] == 0) 1211 register int o, i; 1212 register NODE *l, *r; 1213 1214 switch (o = p->in.op) { 1215 1216 case DIV: case ASG DIV: 1217 case MOD: case ASG MOD: 1218 /* 1219 * Change unsigned mods and divs to 1220 * logicals (mul is done in mip & c2) 1221 */ 1222 if (ISUNSIGNED(p->in.left->in.type) && nncon(p->in.right) && 1223 (i = ispow2(RV(p))) >= 0) { 1224 if (o == DIV || o == ASG DIV) { 1225 p->in.op = RS; 1226 RV(p) = i; 1227 } else { 1228 p->in.op = AND; 1229 RV(p)--; 1230 } 1231 if (asgop(o)) 1232 p->in.op = ASG p->in.op; 1233 } 1234 return; 1235 1236 case SCONV: 1237 l = p->in.left; 1238 /* clobber conversions w/o side effects */ 1239 if (!anyfloat(p, l) && l->in.op != PCONV && 1240 tlen(p) == tlen(l)) { 1241 if (l->in.op != FLD) 1242 l->in.type = p->in.type; 1243 ncopy(p, l); 1244 l->in.op = FREE; 1245 } 1246 return; 1247 1248 case ASSIGN: 1249 /* 1250 * Try to zap storage conversions of non-float items. 1251 */ 1252 r = p->in.right; 1253 if (r->in.op == SCONV && !anyfloat(r->in.left, r)) { 1254 int wdest, wconv, wsrc; 1255 wdest = tlen(p->in.left); 1256 wconv = tlen(r); 1257 /* 1258 * If size doesn't change across assignment or 1259 * conversion expands src before shrinking again 1260 * due to the assignment, delete conversion so 1261 * code generator can create optimal code. 1262 */ 1263 if (wdest == wconv || 1264 (wdest == (wsrc = tlen(r->in.left)) && wconv > wsrc)) { 1265 p->in.right = r->in.left; 1266 r->in.op = FREE; 1267 } 1268 } 1269 return; 1270 } 1271 # endif 1272 } 1273 1274 struct functbl { 1275 int fop; 1276 char *func; 1277 } opfunc[] = { 1278 DIV, "udiv", 1279 ASG DIV, "udiv", 1280 0 1281 }; 1282 1283 hardops(p) register NODE *p; { 1284 /* change hard to do operators into function calls. */ 1285 register NODE *q; 1286 register struct functbl *f; 1287 register int o; 1288 register TWORD t, t1, t2; 1289 1290 o = p->in.op; 1291 1292 for( f=opfunc; f->fop; f++ ) { 1293 if( o==f->fop ) goto convert; 1294 } 1295 return; 1296 1297 convert: 1298 t = p->in.type; 1299 t1 = p->in.left->in.type; 1300 t2 = p->in.right->in.type; 1301 1302 if (!((ISUNSIGNED(t1) && !(ISUNSIGNED(t2))) || 1303 ( t2 == UNSIGNED))) return; 1304 1305 /* need to rewrite tree for ASG OP */ 1306 /* must change ASG OP to a simple OP */ 1307 if( asgop( o ) ) { 1308 q = talloc(); 1309 q->in.op = NOASG ( o ); 1310 q->in.rall = NOPREF; 1311 q->in.type = p->in.type; 1312 q->in.left = tcopy(p->in.left); 1313 q->in.right = p->in.right; 1314 p->in.op = ASSIGN; 1315 p->in.right = q; 1316 zappost(q->in.left); /* remove post-INCR(DECR) from new node */ 1317 fixpre(q->in.left); /* change pre-INCR(DECR) to +/- */ 1318 p = q; 1319 1320 } 1321 /* turn logicals to compare 0 */ 1322 else if( logop( o ) ) { 1323 ncopy(q = talloc(), p); 1324 p->in.left = q; 1325 p->in.right = q = talloc(); 1326 q->in.op = ICON; 1327 q->in.type = INT; 1328 #ifndef FLEXNAMES 1329 q->in.name[0] = '\0'; 1330 #else 1331 q->in.name = ""; 1332 #endif 1333 q->tn.lval = 0; 1334 q->tn.rval = 0; 1335 p = p->in.left; 1336 } 1337 1338 /* build comma op for args to function */ 1339 t1 = p->in.left->in.type; 1340 t2 = 0; 1341 if ( optype(p->in.op) == BITYPE) { 1342 q = talloc(); 1343 q->in.op = CM; 1344 q->in.rall = NOPREF; 1345 q->in.type = INT; 1346 q->in.left = p->in.left; 1347 q->in.right = p->in.right; 1348 t2 = p->in.right->in.type; 1349 } else 1350 q = p->in.left; 1351 1352 p->in.op = CALL; 1353 p->in.right = q; 1354 1355 /* put function name in left node of call */ 1356 p->in.left = q = talloc(); 1357 q->in.op = ICON; 1358 q->in.rall = NOPREF; 1359 q->in.type = INCREF( FTN + p->in.type ); 1360 #ifndef FLEXNAMES 1361 strcpy( q->in.name, f->func ); 1362 #else 1363 q->in.name = f->func; 1364 #endif 1365 q->tn.lval = 0; 1366 q->tn.rval = 0; 1367 1368 } 1369 1370 zappost(p) NODE *p; { 1371 /* look for ++ and -- operators and remove them */ 1372 1373 register int o, ty; 1374 register NODE *q; 1375 o = p->in.op; 1376 ty = optype( o ); 1377 1378 switch( o ){ 1379 1380 case INCR: 1381 case DECR: 1382 q = p->in.left; 1383 p->in.right->in.op = FREE; /* zap constant */ 1384 ncopy( p, q ); 1385 q->in.op = FREE; 1386 return; 1387 1388 } 1389 1390 if( ty == BITYPE ) zappost( p->in.right ); 1391 if( ty != LTYPE ) zappost( p->in.left ); 1392 } 1393 1394 fixpre(p) NODE *p; { 1395 1396 register int o, ty; 1397 o = p->in.op; 1398 ty = optype( o ); 1399 1400 switch( o ){ 1401 1402 case ASG PLUS: 1403 p->in.op = PLUS; 1404 break; 1405 case ASG MINUS: 1406 p->in.op = MINUS; 1407 break; 1408 } 1409 1410 if( ty == BITYPE ) fixpre( p->in.right ); 1411 if( ty != LTYPE ) fixpre( p->in.left ); 1412 } 1413 1414 NODE * addroreg(l) NODE *l; 1415 /* OREG was built in clocal() 1416 * for an auto or formal parameter 1417 * now its address is being taken 1418 * local code must unwind it 1419 * back to PLUS/MINUS REG ICON 1420 * according to local conventions 1421 */ 1422 { 1423 cerror("address of OREG taken"); 1424 } 1425 1426 # ifndef ONEPASS 1427 main( argc, argv ) char *argv[]; { 1428 return( mainp2( argc, argv ) ); 1429 } 1430 # endif 1431 1432 strip(p) register NODE *p; { 1433 NODE *q; 1434 1435 /* strip nodes off the top when no side effects occur */ 1436 for( ; ; ) { 1437 switch( p->in.op ) { 1438 case SCONV: /* remove lint tidbits */ 1439 q = p->in.left; 1440 ncopy( p, q ); 1441 q->in.op = FREE; 1442 break; 1443 /* could probably add a few more here */ 1444 default: 1445 return; 1446 } 1447 } 1448 } 1449 1450 myreader(p) register NODE *p; { 1451 strip( p ); /* strip off operations with no side effects */ 1452 walkf( p, hardops ); /* convert ops to function calls */ 1453 canon( p ); /* expands r-vals for fileds */ 1454 walkf( p, optim2 ); 1455 } 1456