1 #ifndef lint 2 static char sccsid[] = "@(#)local2.c 1.7 (Berkeley) 07/27/86"; 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 prtype(n) NODE *n; 136 { 137 switch (n->in.type) 138 { 139 140 case DOUBLE: 141 putchar('d'); 142 return; 143 144 case FLOAT: 145 putchar('f'); 146 return; 147 148 case INT: 149 case UNSIGNED: 150 putchar('l'); 151 return; 152 153 case SHORT: 154 case USHORT: 155 putchar('w'); 156 return; 157 158 case CHAR: 159 case UCHAR: 160 putchar('b'); 161 return; 162 163 default: 164 if ( !ISPTR( n->in.type ) ) cerror("zzzcode- bad type"); 165 else { 166 putchar('l'); 167 return; 168 } 169 } 170 } 171 172 zzzcode( p, c ) register NODE *p; { 173 register int m; 174 int val; 175 switch( c ){ 176 177 case 'N': /* logical ops, turned into 0-1 */ 178 /* use register given by register 1 */ 179 cbgen( 0, m=getlab(), 'I' ); 180 deflab( p->bn.label ); 181 printf( " clrl %s\n", rname(getlr( p, '1' )->tn.rval) ); 182 deflab( m ); 183 return; 184 185 case 'P': 186 cbgen( p->in.op, p->bn.label, c ); 187 return; 188 189 case 'A': /* assignment and load (integer only) */ 190 { 191 register NODE *l, *r; 192 193 if (xdebug) eprint(p, 0, &val, &val); 194 r = getlr(p, 'R'); 195 if (optype(p->in.op) == LTYPE || p->in.op == UNARY MUL) { 196 l = resc; 197 l->in.type = INT; 198 } else 199 l = getlr(p, 'L'); 200 if(r->in.type==FLOAT || r->in.type==DOUBLE 201 || l->in.type==FLOAT || l->in.type==DOUBLE) 202 cerror("float in ZA"); 203 if (r->in.op == ICON) 204 if(r->in.name[0] == '\0') { 205 if (r->tn.lval == 0) { 206 putstr("clr"); 207 prtype(l); 208 putchar('\t'); 209 adrput(l); 210 return; 211 } 212 if (r->tn.lval < 0 && r->tn.lval >= -63) { 213 putstr("mneg"); 214 prtype(l); 215 r->tn.lval = -r->tn.lval; 216 goto ops; 217 } 218 #ifdef MOVAFASTER 219 } else { 220 putstr("movab\t"); 221 acon(r); 222 putchar(','); 223 adrput(l); 224 return; 225 #endif MOVAFASTER 226 } 227 228 if (l->in.op == REG) { 229 if( tlen(l) < tlen(r) ) { 230 putstr(!ISUNSIGNED(l->in.type)? 231 "cvt": "movz"); 232 prtype(l); 233 putchar('l'); 234 goto ops; 235 } else 236 l->in.type = INT; 237 } 238 if (tlen(l) == tlen(r)) { 239 putstr("mov"); 240 prtype(l); 241 goto ops; 242 } else if (tlen(l) > tlen(r) && ISUNSIGNED(r->in.type)) 243 putstr("movz"); 244 else 245 putstr("cvt"); 246 prtype(r); 247 prtype(l); 248 ops: 249 putchar('\t'); 250 adrput(r); 251 putchar(','); 252 adrput(l); 253 return; 254 } 255 256 case 'B': /* get oreg value in temp register for shift */ 257 { 258 register NODE *r; 259 if (xdebug) eprint(p, 0, &val, &val); 260 r = p->in.right; 261 if( tlen(r) == sizeof(int) && r->in.type != FLOAT ) 262 putstr("movl"); 263 else { 264 putstr(ISUNSIGNED(r->in.type) ? "movz" : "cvt"); 265 prtype(r); 266 putchar('l'); 267 } 268 return; 269 } 270 271 case 'C': /* num bytes pushed on arg stack */ 272 { 273 extern int gc_numbytes; 274 extern int xdebug; 275 276 if (xdebug) printf("->%d<-",gc_numbytes); 277 278 printf("call%c $%d", 279 (p->in.left->in.op==ICON && gc_numbytes<60)?'f':'s', 280 gc_numbytes+4); 281 /* dont change to double (here's the only place to catch it) */ 282 if(p->in.type == FLOAT) 283 rtyflg = 1; 284 return; 285 } 286 287 case 'D': /* INCR and DECR */ 288 zzzcode(p->in.left, 'A'); 289 putstr("\n "); 290 291 case 'E': /* INCR and DECR, FOREFF */ 292 if (p->in.right->tn.lval == 1) 293 { 294 putstr(p->in.op == INCR ? "inc" : "dec"); 295 prtype(p->in.left); 296 putchar('\t'); 297 adrput(p->in.left); 298 return; 299 } 300 putstr(p->in.op == INCR ? "add" : "sub"); 301 prtype(p->in.left); 302 putstr("2 "); 303 adrput(p->in.right); 304 putchar(','); 305 adrput(p->in.left); 306 return; 307 308 case 'F': /* masked constant for fields */ 309 printf(ACONFMT, (p->in.right->tn.lval&((1<<fldsz)-1))<<fldshf); 310 return; 311 312 case 'H': /* opcode for shift */ 313 if(p->in.op == LS || p->in.op == ASG LS) 314 putstr("shll"); 315 else if(ISUNSIGNED(p->in.left->in.type)) 316 putstr("shrl"); 317 else 318 putstr("shar"); 319 return; 320 321 case 'L': /* type of left operand */ 322 case 'R': /* type of right operand */ 323 { 324 register NODE *n; 325 extern int xdebug; 326 327 n = getlr ( p, c); 328 if (xdebug) printf("->%d<-", n->in.type); 329 330 prtype(n); 331 return; 332 } 333 334 case 'M': /* initiate ediv for mod and unsigned div */ 335 { 336 register char *r; 337 m = getlr(p, '1')->tn.rval; 338 r = rname(m); 339 printf("\tclrl\t%s\n\tmovl\t", r); 340 adrput(p->in.left); 341 printf(",%s\n", rname(m+1)); 342 if(!ISUNSIGNED(p->in.type)) { /* should be MOD */ 343 m = getlab(); 344 printf("\tjgeq\tL%d\n\tmnegl\t$1,%s\n", m, r); 345 deflab(m); 346 } 347 } 348 return; 349 350 case 'U': 351 /* Truncate int for type conversions: 352 LONG|ULONG -> CHAR|UCHAR|SHORT|USHORT 353 SHORT|USHORT -> CHAR|UCHAR 354 increment offset to correct byte */ 355 { 356 register NODE *p1; 357 int dif; 358 359 p1 = p->in.left; 360 switch( p1->in.op ){ 361 case NAME: 362 case OREG: 363 dif = tlen(p1)-tlen(p); 364 p1->tn.lval += dif; 365 adrput(p1); 366 p1->tn.lval -= dif; 367 return; 368 default: 369 cerror( "Illegal ZU type conversion" ); 370 return; 371 } 372 } 373 374 case 'T': /* rounded structure length for arguments */ 375 { 376 int size; 377 378 size = p->stn.stsize; 379 SETOFF( size, 4); 380 printf("movab -%d(sp),sp", size); 381 return; 382 } 383 384 case 'S': /* structure assignment */ 385 stasg(p); 386 break; 387 388 case 'X': /* multiplication for short and char */ 389 if (ISUNSIGNED(p->in.left->in.type)) 390 printf("\tmovz"); 391 else 392 printf("\tcvt"); 393 zzzcode(p, 'L'); 394 printf("l\t"); 395 adrput(p->in.left); 396 printf(","); 397 adrput(&resc[0]); 398 printf("\n"); 399 if (ISUNSIGNED(p->in.right->in.type)) 400 printf("\tmovz"); 401 else 402 printf("\tcvt"); 403 zzzcode(p, 'R'); 404 printf("l\t"); 405 adrput(p->in.right); 406 printf(","); 407 adrput(&resc[1]); 408 printf("\n"); 409 return; 410 411 default: 412 cerror( "illegal zzzcode" ); 413 } 414 } 415 416 #define MOVB(dst, src, off) { \ 417 putstr("\tmovb\t"); upput(src, off); putchar(','); \ 418 upput(dst, off); putchar('\n'); \ 419 } 420 #define MOVW(dst, src, off) { \ 421 putstr("\tmovw\t"); upput(src, off); putchar(','); \ 422 upput(dst, off); putchar('\n'); \ 423 } 424 #define MOVL(dst, src, off) { \ 425 putstr("\tmovl\t"); upput(src, off); putchar(','); \ 426 upput(dst, off); putchar('\n'); \ 427 } 428 /* 429 * Generate code for a structure assignment. 430 */ 431 stasg(p) 432 register NODE *p; 433 { 434 register NODE *l, *r; 435 register int size; 436 437 switch (p->in.op) { 438 case STASG: /* regular assignment */ 439 l = p->in.left; 440 r = p->in.right; 441 break; 442 case STARG: /* place arg on the stack */ 443 l = getlr(p, '3'); 444 r = p->in.left; 445 break; 446 default: 447 cerror("STASG bad"); 448 /*NOTREACHED*/ 449 } 450 /* 451 * Pun source for use in code generation. 452 */ 453 switch (r->in.op) { 454 case ICON: 455 r->in.op = NAME; 456 break; 457 case REG: 458 r->in.op = OREG; 459 break; 460 default: 461 cerror( "STASG-r" ); 462 /*NOTREACHED*/ 463 } 464 size = p->stn.stsize; 465 if (size <= 0 || size > 65535) 466 cerror("structure size out of range"); 467 /* 468 * Generate optimized code based on structure size 469 * and alignment properties.... 470 */ 471 switch (size) { 472 473 case 1: 474 putstr("\tmovb\t"); 475 optimized: 476 adrput(r); 477 putchar(','); 478 adrput(l); 479 putchar('\n'); 480 break; 481 482 case 2: 483 if (p->stn.stalign != 2) { 484 MOVB(l, r, SZCHAR); 485 putstr("\tmovb\t"); 486 } else 487 putstr("\tmovw\t"); 488 goto optimized; 489 490 case 4: 491 if (p->stn.stalign != 4) { 492 if (p->stn.stalign != 2) { 493 MOVB(l, r, 3*SZCHAR); 494 MOVB(l, r, 2*SZCHAR); 495 MOVB(l, r, 1*SZCHAR); 496 putstr("\tmovb\t"); 497 } else { 498 MOVW(l, r, SZSHORT); 499 putstr("\tmovw\t"); 500 } 501 } else 502 putstr("\tmovl\t"); 503 goto optimized; 504 505 case 6: 506 if (p->stn.stalign != 2) 507 goto movblk; 508 MOVW(l, r, 2*SZSHORT); 509 MOVW(l, r, 1*SZSHORT); 510 putstr("\tmovw\t"); 511 goto optimized; 512 513 case 8: 514 if (p->stn.stalign == 4) { 515 MOVL(l, r, SZLONG); 516 putstr("\tmovl\t"); 517 goto optimized; 518 } 519 /* fall thru...*/ 520 521 default: 522 movblk: 523 /* 524 * Can we ever get a register conflict with R1 here? 525 */ 526 putstr("\tmovab\t"); 527 adrput(l); 528 putstr(",r1\n\tmovab\t"); 529 adrput(r); 530 printf(",r0\n\tmovl\t$%d,r2\n\tmovblk\n", size); 531 rname(R2); 532 break; 533 } 534 /* 535 * Reverse above pun for reclaim. 536 */ 537 if (r->in.op == NAME) 538 r->in.op = ICON; 539 else if (r->in.op == OREG) 540 r->in.op = REG; 541 } 542 543 /* 544 * Output the address of the second item in the 545 * pair pointed to by p. 546 */ 547 upput(p, size) 548 register NODE *p; 549 { 550 CONSZ save; 551 552 if (p->in.op == FLD) 553 p = p->in.left; 554 switch (p->in.op) { 555 556 case NAME: 557 case OREG: 558 save = p->tn.lval; 559 p->tn.lval += size/SZCHAR; 560 adrput(p); 561 p->tn.lval = save; 562 break; 563 564 case REG: 565 if (size == SZLONG) { 566 putstr(rname(p->tn.rval+1)); 567 break; 568 } 569 /* fall thru... */ 570 571 default: 572 cerror("illegal upper address op %s size %d", 573 opst[p->tn.op], size); 574 /*NOTREACHED*/ 575 } 576 } 577 578 rmove( rt, rs, t ) TWORD t;{ 579 printf( " movl %s,%s\n", rname(rs), rname(rt) ); 580 if(t==DOUBLE) 581 printf( " movl %s,%s\n", rname(rs+1), rname(rt+1) ); 582 } 583 584 struct respref 585 respref[] = { 586 INTAREG|INTBREG, INTAREG|INTBREG, 587 INAREG|INBREG, INAREG|INBREG|SOREG|STARREG|STARNM|SNAME|SCON, 588 INTEMP, INTEMP, 589 FORARG, FORARG, 590 INTEMP, INTAREG|INAREG|INTBREG|INBREG|SOREG|STARREG|STARNM, 591 0, 0 }; 592 593 setregs(){ /* set up temporary registers */ 594 fregs = 6; /* tbl- 6 free regs on Tahoe (0-5) */ 595 } 596 597 #ifndef szty 598 szty(t) TWORD t;{ /* size, in registers, needed to hold thing of type t */ 599 return(t==DOUBLE ? 2 : 1 ); 600 } 601 #endif 602 603 rewfld( p ) NODE *p; { 604 return(1); 605 } 606 607 callreg(p) NODE *p; { 608 return( R0 ); 609 } 610 611 base( p ) register NODE *p; { 612 register int o = p->in.op; 613 614 if( (o==ICON && p->in.name[0] != '\0')) return( 100 ); /* ie no base reg */ 615 if( o==REG ) return( p->tn.rval ); 616 if( (o==PLUS || o==MINUS) && p->in.left->in.op == REG && p->in.right->in.op==ICON) 617 return( p->in.left->tn.rval ); 618 if( o==OREG && !R2TEST(p->tn.rval) && (p->in.type==INT || p->in.type==UNSIGNED || ISPTR(p->in.type)) ) 619 return( p->tn.rval + 0200*1 ); 620 return( -1 ); 621 } 622 623 offset( p, tyl ) register NODE *p; int tyl; { 624 625 if(tyl > 8) return( -1 ); 626 if( tyl==1 && p->in.op==REG && (p->in.type==INT || p->in.type==UNSIGNED) ) return( p->tn.rval ); 627 if( (p->in.op==LS && p->in.left->in.op==REG && (p->in.left->in.type==INT || p->in.left->in.type==UNSIGNED) && 628 (p->in.right->in.op==ICON && p->in.right->in.name[0]=='\0') 629 && (1<<p->in.right->tn.lval)==tyl)) 630 return( p->in.left->tn.rval ); 631 return( -1 ); 632 } 633 634 makeor2( p, q, b, o) register NODE *p, *q; register int b, o; { 635 register NODE *t; 636 register int i; 637 NODE *f; 638 639 p->in.op = OREG; 640 f = p->in.left; /* have to free this subtree later */ 641 642 /* init base */ 643 switch (q->in.op) { 644 case ICON: 645 case REG: 646 case OREG: 647 t = q; 648 break; 649 650 case MINUS: 651 q->in.right->tn.lval = -q->in.right->tn.lval; 652 case PLUS: 653 t = q->in.right; 654 break; 655 656 case UNARY MUL: 657 t = q->in.left->in.left; 658 break; 659 660 default: 661 cerror("illegal makeor2"); 662 } 663 664 p->tn.lval = t->tn.lval; 665 #ifndef FLEXNAMES 666 for(i=0; i<NCHNAM; ++i) 667 p->in.name[i] = t->in.name[i]; 668 #else 669 p->in.name = t->in.name; 670 #endif 671 672 /* init offset */ 673 p->tn.rval = R2PACK( (b & 0177), o, (b>>7) ); 674 675 tfree(f); 676 return; 677 } 678 679 canaddr( p ) NODE *p; { 680 register int o = p->in.op; 681 682 if( o==NAME || o==REG || o==ICON || o==OREG || (o==UNARY MUL && shumul(p->in.left)) ) return(1); 683 return(0); 684 } 685 686 #ifndef shltype 687 shltype( o, p ) register NODE *p; { 688 return( o== REG || o == NAME || o == ICON || o == OREG || ( o==UNARY MUL && shumul(p->in.left)) ); 689 } 690 #endif 691 692 flshape( p ) NODE *p; { 693 register int o = p->in.op; 694 695 if( o==NAME || o==REG || o==ICON || o==OREG || (o==UNARY MUL && shumul(p->in.left)) ) return(1); 696 return(0); 697 } 698 699 shtemp( p ) register NODE *p; { 700 if( p->in.op == STARG ) p = p->in.left; 701 return( p->in.op==NAME || p->in.op ==ICON || p->in.op == OREG || (p->in.op==UNARY MUL && shumul(p->in.left)) ); 702 } 703 704 shumul( p ) register NODE *p; { 705 register int o; 706 extern int xdebug; 707 708 if (xdebug) { 709 printf("\nshumul:op=%d,lop=%d,rop=%d", p->in.op, p->in.left->in.op, p->in.right->in.op); 710 printf(" prname=%s,plty=%d, prlval=%D\n", p->in.right->in.name, p->in.left->in.type, p->in.right->tn.lval); 711 } 712 713 o = p->in.op; 714 if(( o == NAME || (o == OREG && !R2TEST(p->tn.rval)) || o == ICON ) 715 && p->in.type != PTR+DOUBLE) 716 return( STARNM ); 717 718 return( 0 ); 719 } 720 721 special( p, shape ) register NODE *p; { 722 if( shape==SIREG && p->in.op == OREG && R2TEST(p->tn.rval) ) return(1); 723 else return(0); 724 } 725 726 adrcon( val ) CONSZ val; { 727 printf(ACONFMT, val); 728 } 729 730 conput( p ) register NODE *p; { 731 switch( p->in.op ){ 732 733 case ICON: 734 acon( p ); 735 return; 736 737 case REG: 738 putstr(rname(p->tn.rval)); 739 return; 740 741 default: 742 cerror( "illegal conput" ); 743 } 744 } 745 746 insput( p ) NODE *p; { 747 cerror( "insput" ); 748 } 749 750 adrput( p ) register NODE *p; { 751 register int r; 752 /* output an address, with offsets, from p */ 753 754 if( p->in.op == FLD ){ 755 p = p->in.left; 756 } 757 switch( p->in.op ){ 758 759 case NAME: 760 acon( p ); 761 return; 762 763 case ICON: 764 /* addressable value of the constant */ 765 putchar('$'); 766 acon( p ); 767 return; 768 769 case REG: 770 putstr(rname(p->tn.rval)); 771 if(p->in.type == DOUBLE) /* for entry mask */ 772 (void) rname(p->tn.rval+1); 773 return; 774 775 case OREG: 776 r = p->tn.rval; 777 if( R2TEST(r) ){ /* double indexing */ 778 register int flags; 779 780 flags = R2UPK3(r); 781 if( flags & 1 ) putchar('*'); 782 if( p->tn.lval != 0 || p->in.name[0] != '\0' ) acon(p); 783 if( R2UPK1(r) != 100) printf( "(%s)", rname(R2UPK1(r)) ); 784 printf( "[%s]", rname(R2UPK2(r)) ); 785 return; 786 } 787 if( r == FP && p->tn.lval > 0 ){ /* in the argument region */ 788 if( p->in.name[0] != '\0' ) werror( "bad arg temp" ); 789 printf( CONFMT, p->tn.lval ); 790 putstr( "(fp)" ); 791 return; 792 } 793 if( p->tn.lval != 0 || p->in.name[0] != '\0') acon( p ); 794 printf( "(%s)", rname(p->tn.rval) ); 795 return; 796 797 case UNARY MUL: 798 /* STARNM or STARREG found */ 799 if( tshape(p, STARNM) ) { 800 putchar( '*' ); 801 adrput( p->in.left); 802 } 803 return; 804 805 default: 806 cerror( "illegal address" ); 807 return; 808 809 } 810 811 } 812 813 acon( p ) register NODE *p; { /* print out a constant */ 814 815 if( p->in.name[0] == '\0' ){ 816 printf( CONFMT, p->tn.lval); 817 return; 818 } else { 819 #ifndef FLEXNAMES 820 printf( "%.8s", p->in.name ); 821 #else 822 putstr(p->in.name); 823 #endif 824 if (p->tn.lval != 0) { 825 putchar('+'); 826 printf(CONFMT, p->tn.lval); 827 } 828 } 829 } 830 831 genscall( p, cookie ) register NODE *p; { 832 /* structure valued call */ 833 return( gencall( p, cookie ) ); 834 } 835 836 genfcall( p, cookie ) register NODE *p; { 837 register NODE *p1; 838 register int m; 839 static char *funcops[6] = { 840 "sin", "cos", "sqrt", "exp", "log", "atan" 841 }; 842 843 /* generate function opcodes */ 844 if(p->in.op==UNARY FORTCALL && p->in.type==FLOAT && 845 (p1 = p->in.left)->in.op==ICON && 846 p1->tn.lval==0 && p1->in.type==INCREF(FTN|FLOAT)) { 847 #ifdef FLEXNAMES 848 p1->in.name++; 849 #else 850 strcpy(p1->in.name, p1->in.name[1]); 851 #endif 852 for(m=0; m<6; m++) 853 if(!strcmp(p1->in.name, funcops[m])) 854 break; 855 if(m >= 6) 856 uerror("no opcode for fortarn function %s", p1->in.name); 857 } else 858 uerror("illegal type of fortarn function"); 859 p1 = p->in.right; 860 p->in.op = FORTCALL; 861 if(!canaddr(p1)) 862 order( p1, INAREG|INBREG|SOREG|STARREG|STARNM ); 863 m = match( p, INTAREG|INTBREG ); 864 return(m != MDONE); 865 } 866 867 /* tbl */ 868 int gc_numbytes; 869 /* tbl */ 870 871 gencall( p, cookie ) register NODE *p; { 872 /* generate the call given by p */ 873 register NODE *p1, *ptemp; 874 register int temp, temp1; 875 register int m; 876 877 if( p->in.right ) temp = argsize( p->in.right ); 878 else temp = 0; 879 880 if( p->in.op == STCALL || p->in.op == UNARY STCALL ){ 881 /* set aside room for structure return */ 882 883 if( p->stn.stsize > temp ) temp1 = p->stn.stsize; 884 else temp1 = temp; 885 } 886 887 if( temp > maxargs ) maxargs = temp; 888 SETOFF(temp1,4); 889 890 if( p->in.right ){ /* make temp node, put offset in, and generate args */ 891 ptemp = talloc(); 892 ptemp->in.op = OREG; 893 ptemp->tn.lval = -1; 894 ptemp->tn.rval = SP; 895 #ifndef FLEXNAMES 896 ptemp->in.name[0] = '\0'; 897 #else 898 ptemp->in.name = ""; 899 #endif 900 ptemp->in.rall = NOPREF; 901 ptemp->in.su = 0; 902 genargs( p->in.right, ptemp ); 903 ptemp->in.op = FREE; 904 } 905 906 p1 = p->in.left; 907 if( p1->in.op != ICON ){ 908 if( p1->in.op != REG ){ 909 if( p1->in.op != OREG || R2TEST(p1->tn.rval) ){ 910 if( p1->in.op != NAME ){ 911 order( p1, INAREG ); 912 } 913 } 914 } 915 } 916 917 /* tbl 918 setup gc_numbytes so reference to ZC works */ 919 920 gc_numbytes = temp&(0x3ff); 921 922 p->in.op = UNARY CALL; 923 m = match( p, INTAREG|INTBREG ); 924 925 return(m != MDONE); 926 } 927 928 /* tbl */ 929 char * 930 ccbranches[] = { 931 "eql", 932 "neq", 933 "leq", 934 "lss", 935 "geq", 936 "gtr", 937 "lequ", 938 "lssu", 939 "gequ", 940 "gtru", 941 }; 942 /* tbl */ 943 944 cbgen( o, lab, mode ) { /* printf conditional and unconditional branches */ 945 946 if(o != 0 && (o < EQ || o > UGT )) 947 cerror( "bad conditional branch: %s", opst[o] ); 948 printf( " j%s L%d\n", 949 o == 0 ? "br" : ccbranches[o-EQ], lab ); 950 } 951 952 nextcook( p, cookie ) NODE *p; { 953 /* we have failed to match p with cookie; try another */ 954 if( cookie == FORREW ) return( 0 ); /* hopeless! */ 955 if( !(cookie&(INTAREG|INTBREG)) ) return( INTAREG|INTBREG ); 956 if( !(cookie&INTEMP) && asgop(p->in.op) ) return( INTEMP|INAREG|INTAREG|INTBREG|INBREG ); 957 return( FORREW ); 958 } 959 960 lastchance( p, cook ) NODE *p; { 961 /* forget it! */ 962 return(0); 963 } 964 965 optim2( p ) register NODE *p; { 966 # ifdef ONEPASS 967 /* do local tree transformations and optimizations */ 968 # define RV(p) p->in.right->tn.lval 969 # define nncon(p) ((p)->in.op == ICON && (p)->in.name[0] == 0) 970 register int o = p->in.op; 971 register int i; 972 973 /* change unsigned mods and divs to logicals (mul is done in mip & c2) */ 974 if(optype(o) == BITYPE && ISUNSIGNED(p->in.left->in.type) 975 && nncon(p->in.right) && (i=ispow2(RV(p)))>=0){ 976 switch(o) { 977 case DIV: 978 case ASG DIV: 979 p->in.op = RS; 980 RV(p) = i; 981 break; 982 case MOD: 983 case ASG MOD: 984 p->in.op = AND; 985 RV(p)--; 986 break; 987 default: 988 return; 989 } 990 if(asgop(o)) 991 p->in.op = ASG p->in.op; 992 } 993 # endif 994 } 995 996 struct functbl { 997 int fop; 998 char *func; 999 } opfunc[] = { 1000 DIV, "udiv", 1001 ASG DIV, "udiv", 1002 0 1003 }; 1004 1005 hardops(p) register NODE *p; { 1006 /* change hard to do operators into function calls. */ 1007 register NODE *q; 1008 register struct functbl *f; 1009 register int o; 1010 register TWORD t, t1, t2; 1011 1012 o = p->in.op; 1013 1014 for( f=opfunc; f->fop; f++ ) { 1015 if( o==f->fop ) goto convert; 1016 } 1017 return; 1018 1019 convert: 1020 t = p->in.type; 1021 t1 = p->in.left->in.type; 1022 t2 = p->in.right->in.type; 1023 1024 if (!((ISUNSIGNED(t1) && !(ISUNSIGNED(t2))) || 1025 ( t2 == UNSIGNED))) return; 1026 1027 /* need to rewrite tree for ASG OP */ 1028 /* must change ASG OP to a simple OP */ 1029 if( asgop( o ) ) { 1030 q = talloc(); 1031 q->in.op = NOASG ( o ); 1032 q->in.rall = NOPREF; 1033 q->in.type = p->in.type; 1034 q->in.left = tcopy(p->in.left); 1035 q->in.right = p->in.right; 1036 p->in.op = ASSIGN; 1037 p->in.right = q; 1038 zappost(q->in.left); /* remove post-INCR(DECR) from new node */ 1039 fixpre(q->in.left); /* change pre-INCR(DECR) to +/- */ 1040 p = q; 1041 1042 } 1043 /* turn logicals to compare 0 */ 1044 else if( logop( o ) ) { 1045 ncopy(q = talloc(), p); 1046 p->in.left = q; 1047 p->in.right = q = talloc(); 1048 q->in.op = ICON; 1049 q->in.type = INT; 1050 #ifndef FLEXNAMES 1051 q->in.name[0] = '\0'; 1052 #else 1053 q->in.name = ""; 1054 #endif 1055 q->tn.lval = 0; 1056 q->tn.rval = 0; 1057 p = p->in.left; 1058 } 1059 1060 /* build comma op for args to function */ 1061 t1 = p->in.left->in.type; 1062 t2 = 0; 1063 if ( optype(p->in.op) == BITYPE) { 1064 q = talloc(); 1065 q->in.op = CM; 1066 q->in.rall = NOPREF; 1067 q->in.type = INT; 1068 q->in.left = p->in.left; 1069 q->in.right = p->in.right; 1070 t2 = p->in.right->in.type; 1071 } else 1072 q = p->in.left; 1073 1074 p->in.op = CALL; 1075 p->in.right = q; 1076 1077 /* put function name in left node of call */ 1078 p->in.left = q = talloc(); 1079 q->in.op = ICON; 1080 q->in.rall = NOPREF; 1081 q->in.type = INCREF( FTN + p->in.type ); 1082 #ifndef FLEXNAMES 1083 strcpy( q->in.name, f->func ); 1084 #else 1085 q->in.name = f->func; 1086 #endif 1087 q->tn.lval = 0; 1088 q->tn.rval = 0; 1089 1090 } 1091 1092 zappost(p) NODE *p; { 1093 /* look for ++ and -- operators and remove them */ 1094 1095 register int o, ty; 1096 register NODE *q; 1097 o = p->in.op; 1098 ty = optype( o ); 1099 1100 switch( o ){ 1101 1102 case INCR: 1103 case DECR: 1104 q = p->in.left; 1105 p->in.right->in.op = FREE; /* zap constant */ 1106 ncopy( p, q ); 1107 q->in.op = FREE; 1108 return; 1109 1110 } 1111 1112 if( ty == BITYPE ) zappost( p->in.right ); 1113 if( ty != LTYPE ) zappost( p->in.left ); 1114 } 1115 1116 fixpre(p) NODE *p; { 1117 1118 register int o, ty; 1119 o = p->in.op; 1120 ty = optype( o ); 1121 1122 switch( o ){ 1123 1124 case ASG PLUS: 1125 p->in.op = PLUS; 1126 break; 1127 case ASG MINUS: 1128 p->in.op = MINUS; 1129 break; 1130 } 1131 1132 if( ty == BITYPE ) fixpre( p->in.right ); 1133 if( ty != LTYPE ) fixpre( p->in.left ); 1134 } 1135 1136 NODE * addroreg(l) NODE *l; 1137 /* OREG was built in clocal() 1138 * for an auto or formal parameter 1139 * now its address is being taken 1140 * local code must unwind it 1141 * back to PLUS/MINUS REG ICON 1142 * according to local conventions 1143 */ 1144 { 1145 cerror("address of OREG taken"); 1146 } 1147 1148 # ifndef ONEPASS 1149 main( argc, argv ) char *argv[]; { 1150 return( mainp2( argc, argv ) ); 1151 } 1152 # endif 1153 1154 myreader(p) register NODE *p; { 1155 walkf( p, hardops ); /* convert ops to function calls */ 1156 canon( p ); /* expands r-vals for fileds */ 1157 walkf( p, optim2 ); 1158 } 1159