1 #ifndef lint 2 static char sccsid[] = "@(#)local2.c 1.8 (Berkeley) 01/09/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 /* 583 * Generate code for storage conversions. 584 */ 585 sconv(p, forcc) 586 NODE *p; 587 { 588 register NODE *l, *r; 589 register wfrom, wto; 590 int oltype; 591 592 l = getlr(p, '1'); 593 oltype = l->in.type, l->in.type = r->in.type; 594 r = getlr(p, 'L'); 595 wfrom = tlen(r), wto = tlen(l); 596 if (wfrom == wto) /* e.g. int -> unsigned */ 597 goto done; 598 /* 599 * Conversion in registers requires care 600 * as cvt and movz instruction don't work 601 * as expected (they end up as plain mov's). 602 */ 603 if (l->in.op == REG && r->in.op == REG) { 604 if (ISUNSIGNED(r->in.type)) { /* unsigned, mask */ 605 if (r->tn.lval != l->tn.lval) { 606 printf("\tandl3\t$%d,", (1<<(wto*SZCHAR))-1); 607 adrput(r); 608 putchar(','); 609 } else 610 printf("\tandl2\t$%d,", (1<<(wto*SZCHAR))-1); 611 adrput(l); 612 } else { /* effect sign-extend */ 613 int shift = (sizeof (int)-wto)*SZCHAR; 614 printf("\tshll\t$%d,", shift); 615 adrput(r); putchar(','); adrput(l); 616 printf("\n\tshar\t$%d,", shift); 617 adrput(l); putchar(','); adrput(l); 618 if (wfrom != sizeof (int)) { 619 /* 620 * Must mask if result is shorter than 621 * the width of a register (to account 622 * for register treatment). 623 */ 624 printf("\n\tandl2\t$%d,",(1<<(wfrom*SZCHAR))-1); 625 adrput(l); 626 } else 627 forcc = 0; 628 } 629 /* 630 * If condition codes are required and the last thing 631 * we did was mask the result, then we must generate a 632 * test of the appropriate type. 633 */ 634 if (forcc) { 635 printf("\n\tcmp"); 636 prtype(l); 637 putchar('\t'); 638 printf("$0,"); 639 adrput(l); 640 } 641 } else { 642 /* 643 * Conversion with at least one parameter in memory. 644 */ 645 if (wfrom < wto) { /* expanding datum */ 646 if (ISUNSIGNED(r->in.type)) { 647 printf("\tmovz"); 648 prtype(r); 649 /* 650 * If target is a register, generate 651 * movz?l so optimizer can compress 652 * argument pushes. 653 */ 654 if (l->in.op == REG) 655 putchar('l'); 656 else 657 prtype(l); 658 } else { 659 printf("\tcvt"); 660 prtype(r), prtype(l); 661 } 662 putchar('\t'); 663 adrput(r); 664 } else { /* shrinking dataum */ 665 int off = wfrom - wto; 666 if (l->in.op == REG) { 667 printf("\tmovz"); 668 prtype(l); 669 putchar('l'); 670 } else { 671 printf("\tcvt"); 672 prtype(l), prtype(r); 673 } 674 putchar('\t'); 675 switch (r->in.op) { 676 case NAME: case OREG: 677 r->tn.lval += off; 678 adrput(r); 679 r->tn.lval -= off; 680 break; 681 case REG: case ICON: case UNARY MUL: 682 adrput(r); 683 break; 684 default: 685 cerror("sconv: bad shrink op"); 686 /*NOTREACHED*/ 687 } 688 } 689 putchar(','); 690 adrput(l); 691 } 692 putchar('\n'); 693 done: 694 l->in.type = oltype; 695 } 696 697 rmove( rt, rs, t ) TWORD t;{ 698 printf( " movl %s,%s\n", rname(rs), rname(rt) ); 699 if(t==DOUBLE) 700 printf( " movl %s,%s\n", rname(rs+1), rname(rt+1) ); 701 } 702 703 struct respref 704 respref[] = { 705 INTAREG|INTBREG, INTAREG|INTBREG, 706 INAREG|INBREG, INAREG|INBREG|SOREG|STARREG|STARNM|SNAME|SCON, 707 INTEMP, INTEMP, 708 FORARG, FORARG, 709 INTEMP, INTAREG|INAREG|INTBREG|INBREG|SOREG|STARREG|STARNM, 710 0, 0 }; 711 712 setregs(){ /* set up temporary registers */ 713 fregs = 6; /* tbl- 6 free regs on Tahoe (0-5) */ 714 } 715 716 #ifndef szty 717 szty(t) TWORD t;{ /* size, in registers, needed to hold thing of type t */ 718 return(t==DOUBLE ? 2 : 1 ); 719 } 720 #endif 721 722 rewfld( p ) NODE *p; { 723 return(1); 724 } 725 726 callreg(p) NODE *p; { 727 return( R0 ); 728 } 729 730 base( p ) register NODE *p; { 731 register int o = p->in.op; 732 733 if( (o==ICON && p->in.name[0] != '\0')) return( 100 ); /* ie no base reg */ 734 if( o==REG ) return( p->tn.rval ); 735 if( (o==PLUS || o==MINUS) && p->in.left->in.op == REG && p->in.right->in.op==ICON) 736 return( p->in.left->tn.rval ); 737 if( o==OREG && !R2TEST(p->tn.rval) && (p->in.type==INT || p->in.type==UNSIGNED || ISPTR(p->in.type)) ) 738 return( p->tn.rval + 0200*1 ); 739 return( -1 ); 740 } 741 742 offset( p, tyl ) register NODE *p; int tyl; { 743 744 if(tyl > 8) return( -1 ); 745 if( tyl==1 && p->in.op==REG && (p->in.type==INT || p->in.type==UNSIGNED) ) return( p->tn.rval ); 746 if( (p->in.op==LS && p->in.left->in.op==REG && (p->in.left->in.type==INT || p->in.left->in.type==UNSIGNED) && 747 (p->in.right->in.op==ICON && p->in.right->in.name[0]=='\0') 748 && (1<<p->in.right->tn.lval)==tyl)) 749 return( p->in.left->tn.rval ); 750 return( -1 ); 751 } 752 753 makeor2( p, q, b, o) register NODE *p, *q; register int b, o; { 754 register NODE *t; 755 register int i; 756 NODE *f; 757 758 p->in.op = OREG; 759 f = p->in.left; /* have to free this subtree later */ 760 761 /* init base */ 762 switch (q->in.op) { 763 case ICON: 764 case REG: 765 case OREG: 766 t = q; 767 break; 768 769 case MINUS: 770 q->in.right->tn.lval = -q->in.right->tn.lval; 771 case PLUS: 772 t = q->in.right; 773 break; 774 775 case UNARY MUL: 776 t = q->in.left->in.left; 777 break; 778 779 default: 780 cerror("illegal makeor2"); 781 } 782 783 p->tn.lval = t->tn.lval; 784 #ifndef FLEXNAMES 785 for(i=0; i<NCHNAM; ++i) 786 p->in.name[i] = t->in.name[i]; 787 #else 788 p->in.name = t->in.name; 789 #endif 790 791 /* init offset */ 792 p->tn.rval = R2PACK( (b & 0177), o, (b>>7) ); 793 794 tfree(f); 795 return; 796 } 797 798 canaddr( p ) NODE *p; { 799 register int o = p->in.op; 800 801 if( o==NAME || o==REG || o==ICON || o==OREG || (o==UNARY MUL && shumul(p->in.left)) ) return(1); 802 return(0); 803 } 804 805 #ifndef shltype 806 shltype( o, p ) register NODE *p; { 807 return( o== REG || o == NAME || o == ICON || o == OREG || ( o==UNARY MUL && shumul(p->in.left)) ); 808 } 809 #endif 810 811 flshape( p ) NODE *p; { 812 register int o = p->in.op; 813 814 if( o==NAME || o==REG || o==ICON || o==OREG || (o==UNARY MUL && shumul(p->in.left)) ) return(1); 815 return(0); 816 } 817 818 shtemp( p ) register NODE *p; { 819 if( p->in.op == STARG ) p = p->in.left; 820 return( p->in.op==NAME || p->in.op ==ICON || p->in.op == OREG || (p->in.op==UNARY MUL && shumul(p->in.left)) ); 821 } 822 823 shumul( p ) register NODE *p; { 824 register int o; 825 extern int xdebug; 826 827 if (xdebug) { 828 printf("\nshumul:op=%d,lop=%d,rop=%d", p->in.op, p->in.left->in.op, p->in.right->in.op); 829 printf(" prname=%s,plty=%d, prlval=%D\n", p->in.right->in.name, p->in.left->in.type, p->in.right->tn.lval); 830 } 831 832 o = p->in.op; 833 if(( o == NAME || (o == OREG && !R2TEST(p->tn.rval)) || o == ICON ) 834 && p->in.type != PTR+DOUBLE) 835 return( STARNM ); 836 837 return( 0 ); 838 } 839 840 special( p, shape ) register NODE *p; { 841 if( shape==SIREG && p->in.op == OREG && R2TEST(p->tn.rval) ) return(1); 842 else return(0); 843 } 844 845 adrcon( val ) CONSZ val; { 846 printf(ACONFMT, val); 847 } 848 849 conput( p ) register NODE *p; { 850 switch( p->in.op ){ 851 852 case ICON: 853 acon( p ); 854 return; 855 856 case REG: 857 putstr(rname(p->tn.rval)); 858 return; 859 860 default: 861 cerror( "illegal conput" ); 862 } 863 } 864 865 insput( p ) NODE *p; { 866 cerror( "insput" ); 867 } 868 869 adrput( p ) register NODE *p; { 870 register int r; 871 /* output an address, with offsets, from p */ 872 873 if( p->in.op == FLD ){ 874 p = p->in.left; 875 } 876 switch( p->in.op ){ 877 878 case NAME: 879 acon( p ); 880 return; 881 882 case ICON: 883 /* addressable value of the constant */ 884 putchar('$'); 885 acon( p ); 886 return; 887 888 case REG: 889 putstr(rname(p->tn.rval)); 890 if(p->in.type == DOUBLE) /* for entry mask */ 891 (void) rname(p->tn.rval+1); 892 return; 893 894 case OREG: 895 r = p->tn.rval; 896 if( R2TEST(r) ){ /* double indexing */ 897 register int flags; 898 899 flags = R2UPK3(r); 900 if( flags & 1 ) putchar('*'); 901 if( p->tn.lval != 0 || p->in.name[0] != '\0' ) acon(p); 902 if( R2UPK1(r) != 100) printf( "(%s)", rname(R2UPK1(r)) ); 903 printf( "[%s]", rname(R2UPK2(r)) ); 904 return; 905 } 906 if( r == FP && p->tn.lval > 0 ){ /* in the argument region */ 907 if( p->in.name[0] != '\0' ) werror( "bad arg temp" ); 908 printf( CONFMT, p->tn.lval ); 909 putstr( "(fp)" ); 910 return; 911 } 912 if( p->tn.lval != 0 || p->in.name[0] != '\0') acon( p ); 913 printf( "(%s)", rname(p->tn.rval) ); 914 return; 915 916 case UNARY MUL: 917 /* STARNM or STARREG found */ 918 if( tshape(p, STARNM) ) { 919 putchar( '*' ); 920 adrput( p->in.left); 921 } 922 return; 923 924 default: 925 cerror( "illegal address" ); 926 return; 927 928 } 929 930 } 931 932 acon( p ) register NODE *p; { /* print out a constant */ 933 934 if( p->in.name[0] == '\0' ){ 935 printf( CONFMT, p->tn.lval); 936 return; 937 } else { 938 #ifndef FLEXNAMES 939 printf( "%.8s", p->in.name ); 940 #else 941 putstr(p->in.name); 942 #endif 943 if (p->tn.lval != 0) { 944 putchar('+'); 945 printf(CONFMT, p->tn.lval); 946 } 947 } 948 } 949 950 genscall( p, cookie ) register NODE *p; { 951 /* structure valued call */ 952 return( gencall( p, cookie ) ); 953 } 954 955 genfcall( p, cookie ) register NODE *p; { 956 register NODE *p1; 957 register int m; 958 static char *funcops[6] = { 959 "sin", "cos", "sqrt", "exp", "log", "atan" 960 }; 961 962 /* generate function opcodes */ 963 if(p->in.op==UNARY FORTCALL && p->in.type==FLOAT && 964 (p1 = p->in.left)->in.op==ICON && 965 p1->tn.lval==0 && p1->in.type==INCREF(FTN|FLOAT)) { 966 #ifdef FLEXNAMES 967 p1->in.name++; 968 #else 969 strcpy(p1->in.name, p1->in.name[1]); 970 #endif 971 for(m=0; m<6; m++) 972 if(!strcmp(p1->in.name, funcops[m])) 973 break; 974 if(m >= 6) 975 uerror("no opcode for fortarn function %s", p1->in.name); 976 } else 977 uerror("illegal type of fortarn function"); 978 p1 = p->in.right; 979 p->in.op = FORTCALL; 980 if(!canaddr(p1)) 981 order( p1, INAREG|INBREG|SOREG|STARREG|STARNM ); 982 m = match( p, INTAREG|INTBREG ); 983 return(m != MDONE); 984 } 985 986 /* tbl */ 987 int gc_numbytes; 988 /* tbl */ 989 990 gencall( p, cookie ) register NODE *p; { 991 /* generate the call given by p */ 992 register NODE *p1, *ptemp; 993 register int temp, temp1; 994 register int m; 995 996 if( p->in.right ) temp = argsize( p->in.right ); 997 else temp = 0; 998 999 if( p->in.op == STCALL || p->in.op == UNARY STCALL ){ 1000 /* set aside room for structure return */ 1001 1002 if( p->stn.stsize > temp ) temp1 = p->stn.stsize; 1003 else temp1 = temp; 1004 } 1005 1006 if( temp > maxargs ) maxargs = temp; 1007 SETOFF(temp1,4); 1008 1009 if( p->in.right ){ /* make temp node, put offset in, and generate args */ 1010 ptemp = talloc(); 1011 ptemp->in.op = OREG; 1012 ptemp->tn.lval = -1; 1013 ptemp->tn.rval = SP; 1014 #ifndef FLEXNAMES 1015 ptemp->in.name[0] = '\0'; 1016 #else 1017 ptemp->in.name = ""; 1018 #endif 1019 ptemp->in.rall = NOPREF; 1020 ptemp->in.su = 0; 1021 genargs( p->in.right, ptemp ); 1022 ptemp->in.op = FREE; 1023 } 1024 1025 p1 = p->in.left; 1026 if( p1->in.op != ICON ){ 1027 if( p1->in.op != REG ){ 1028 if( p1->in.op != OREG || R2TEST(p1->tn.rval) ){ 1029 if( p1->in.op != NAME ){ 1030 order( p1, INAREG ); 1031 } 1032 } 1033 } 1034 } 1035 1036 /* tbl 1037 setup gc_numbytes so reference to ZC works */ 1038 1039 gc_numbytes = temp&(0x3ff); 1040 1041 p->in.op = UNARY CALL; 1042 m = match( p, INTAREG|INTBREG ); 1043 1044 return(m != MDONE); 1045 } 1046 1047 /* tbl */ 1048 char * 1049 ccbranches[] = { 1050 "eql", 1051 "neq", 1052 "leq", 1053 "lss", 1054 "geq", 1055 "gtr", 1056 "lequ", 1057 "lssu", 1058 "gequ", 1059 "gtru", 1060 }; 1061 /* tbl */ 1062 1063 cbgen( o, lab, mode ) { /* printf conditional and unconditional branches */ 1064 1065 if(o != 0 && (o < EQ || o > UGT )) 1066 cerror( "bad conditional branch: %s", opst[o] ); 1067 printf( " j%s L%d\n", 1068 o == 0 ? "br" : ccbranches[o-EQ], lab ); 1069 } 1070 1071 nextcook( p, cookie ) NODE *p; { 1072 /* we have failed to match p with cookie; try another */ 1073 if( cookie == FORREW ) return( 0 ); /* hopeless! */ 1074 if( !(cookie&(INTAREG|INTBREG)) ) return( INTAREG|INTBREG ); 1075 if( !(cookie&INTEMP) && asgop(p->in.op) ) return( INTEMP|INAREG|INTAREG|INTBREG|INBREG ); 1076 return( FORREW ); 1077 } 1078 1079 lastchance( p, cook ) NODE *p; { 1080 /* forget it! */ 1081 return(0); 1082 } 1083 1084 optim2( p ) register NODE *p; { 1085 # ifdef ONEPASS 1086 /* do local tree transformations and optimizations */ 1087 # define RV(p) p->in.right->tn.lval 1088 # define nncon(p) ((p)->in.op == ICON && (p)->in.name[0] == 0) 1089 register int o, i; 1090 register NODE *l, *r; 1091 1092 switch (o = p->in.op) { 1093 1094 case DIV: case ASG DIV: 1095 case MOD: case ASG MOD: 1096 /* 1097 * Change unsigned mods and divs to 1098 * logicals (mul is done in mip & c2) 1099 */ 1100 if (ISUNSIGNED(p->in.left->in.type) && nncon(p->in.right) && 1101 (i = ispow2(RV(p))) >= 0) { 1102 if (o == DIV || o == ASG DIV) { 1103 p->in.op = RS; 1104 RV(p) = i; 1105 } else { 1106 p->in.op = AND; 1107 RV(p)--; 1108 } 1109 if (asgop(o)) 1110 p->in.op = ASG p->in.op; 1111 } 1112 return; 1113 1114 case SCONV: 1115 l = p->in.left; 1116 /* clobber conversions w/o side effects */ 1117 if (!anyfloat(p, l) && l->in.op != PCONV && 1118 tlen(p) == tlen(l)) { 1119 if (l->in.op != FLD) 1120 l->in.type = p->in.type; 1121 ncopy(p, l); 1122 l->in.op = FREE; 1123 } 1124 return; 1125 1126 case ASSIGN: 1127 /* 1128 * Try to zap storage conversions of non-float items. 1129 */ 1130 r = p->in.right; 1131 if (r->in.op == SCONV && !anyfloat(r->in.left, r)) { 1132 int wdest, wconv, wsrc; 1133 wdest = tlen(p->in.left); 1134 wconv = tlen(r); 1135 /* 1136 * If size doesn't change across assignment or 1137 * conversion expands src before shrinking again 1138 * due to the assignment, delete conversion so 1139 * code generator can create optimal code. 1140 */ 1141 if (wdest == wconv || 1142 (wdest == (wsrc = tlen(r->in.left)) && wconv > wsrc)) { 1143 p->in.right = r->in.left; 1144 r->in.op = FREE; 1145 } 1146 } 1147 return; 1148 } 1149 # endif 1150 } 1151 1152 struct functbl { 1153 int fop; 1154 char *func; 1155 } opfunc[] = { 1156 DIV, "udiv", 1157 ASG DIV, "udiv", 1158 0 1159 }; 1160 1161 hardops(p) register NODE *p; { 1162 /* change hard to do operators into function calls. */ 1163 register NODE *q; 1164 register struct functbl *f; 1165 register int o; 1166 register TWORD t, t1, t2; 1167 1168 o = p->in.op; 1169 1170 for( f=opfunc; f->fop; f++ ) { 1171 if( o==f->fop ) goto convert; 1172 } 1173 return; 1174 1175 convert: 1176 t = p->in.type; 1177 t1 = p->in.left->in.type; 1178 t2 = p->in.right->in.type; 1179 1180 if (!((ISUNSIGNED(t1) && !(ISUNSIGNED(t2))) || 1181 ( t2 == UNSIGNED))) return; 1182 1183 /* need to rewrite tree for ASG OP */ 1184 /* must change ASG OP to a simple OP */ 1185 if( asgop( o ) ) { 1186 q = talloc(); 1187 q->in.op = NOASG ( o ); 1188 q->in.rall = NOPREF; 1189 q->in.type = p->in.type; 1190 q->in.left = tcopy(p->in.left); 1191 q->in.right = p->in.right; 1192 p->in.op = ASSIGN; 1193 p->in.right = q; 1194 zappost(q->in.left); /* remove post-INCR(DECR) from new node */ 1195 fixpre(q->in.left); /* change pre-INCR(DECR) to +/- */ 1196 p = q; 1197 1198 } 1199 /* turn logicals to compare 0 */ 1200 else if( logop( o ) ) { 1201 ncopy(q = talloc(), p); 1202 p->in.left = q; 1203 p->in.right = q = talloc(); 1204 q->in.op = ICON; 1205 q->in.type = INT; 1206 #ifndef FLEXNAMES 1207 q->in.name[0] = '\0'; 1208 #else 1209 q->in.name = ""; 1210 #endif 1211 q->tn.lval = 0; 1212 q->tn.rval = 0; 1213 p = p->in.left; 1214 } 1215 1216 /* build comma op for args to function */ 1217 t1 = p->in.left->in.type; 1218 t2 = 0; 1219 if ( optype(p->in.op) == BITYPE) { 1220 q = talloc(); 1221 q->in.op = CM; 1222 q->in.rall = NOPREF; 1223 q->in.type = INT; 1224 q->in.left = p->in.left; 1225 q->in.right = p->in.right; 1226 t2 = p->in.right->in.type; 1227 } else 1228 q = p->in.left; 1229 1230 p->in.op = CALL; 1231 p->in.right = q; 1232 1233 /* put function name in left node of call */ 1234 p->in.left = q = talloc(); 1235 q->in.op = ICON; 1236 q->in.rall = NOPREF; 1237 q->in.type = INCREF( FTN + p->in.type ); 1238 #ifndef FLEXNAMES 1239 strcpy( q->in.name, f->func ); 1240 #else 1241 q->in.name = f->func; 1242 #endif 1243 q->tn.lval = 0; 1244 q->tn.rval = 0; 1245 1246 } 1247 1248 zappost(p) NODE *p; { 1249 /* look for ++ and -- operators and remove them */ 1250 1251 register int o, ty; 1252 register NODE *q; 1253 o = p->in.op; 1254 ty = optype( o ); 1255 1256 switch( o ){ 1257 1258 case INCR: 1259 case DECR: 1260 q = p->in.left; 1261 p->in.right->in.op = FREE; /* zap constant */ 1262 ncopy( p, q ); 1263 q->in.op = FREE; 1264 return; 1265 1266 } 1267 1268 if( ty == BITYPE ) zappost( p->in.right ); 1269 if( ty != LTYPE ) zappost( p->in.left ); 1270 } 1271 1272 fixpre(p) NODE *p; { 1273 1274 register int o, ty; 1275 o = p->in.op; 1276 ty = optype( o ); 1277 1278 switch( o ){ 1279 1280 case ASG PLUS: 1281 p->in.op = PLUS; 1282 break; 1283 case ASG MINUS: 1284 p->in.op = MINUS; 1285 break; 1286 } 1287 1288 if( ty == BITYPE ) fixpre( p->in.right ); 1289 if( ty != LTYPE ) fixpre( p->in.left ); 1290 } 1291 1292 NODE * addroreg(l) NODE *l; 1293 /* OREG was built in clocal() 1294 * for an auto or formal parameter 1295 * now its address is being taken 1296 * local code must unwind it 1297 * back to PLUS/MINUS REG ICON 1298 * according to local conventions 1299 */ 1300 { 1301 cerror("address of OREG taken"); 1302 } 1303 1304 # ifndef ONEPASS 1305 main( argc, argv ) char *argv[]; { 1306 return( mainp2( argc, argv ) ); 1307 } 1308 # endif 1309 1310 strip(p) register NODE *p; { 1311 NODE *q; 1312 1313 /* strip nodes off the top when no side effects occur */ 1314 for( ; ; ) { 1315 switch( p->in.op ) { 1316 case SCONV: /* remove lint tidbits */ 1317 q = p->in.left; 1318 ncopy( p, q ); 1319 q->in.op = FREE; 1320 break; 1321 /* could probably add a few more here */ 1322 default: 1323 return; 1324 } 1325 } 1326 } 1327 1328 myreader(p) register NODE *p; { 1329 strip( p ); /* strip off operations with no side effects */ 1330 walkf( p, hardops ); /* convert ops to function calls */ 1331 canon( p ); /* expands r-vals for fileds */ 1332 walkf( p, optim2 ); 1333 } 1334