1 /*- 2 * Copyright (c) 1980 The Regents of the University of California. 3 * All rights reserved. 4 * 5 * %sccs.include.proprietary.c% 6 */ 7 8 #ifndef lint 9 static char sccsid[] = "@(#)tahoe.c 5.3 (Berkeley) 04/12/91"; 10 #endif /* not lint */ 11 12 #include "defs.h" 13 14 #ifdef SDB 15 # include <a.out.h> 16 extern int types2[]; 17 # ifndef N_SO 18 # include <stab.h> 19 # endif 20 #endif 21 22 #include "pcc.h" 23 24 /* 25 TAHOE - SPECIFIC ROUTINES 26 */ 27 28 int maxregvar = MAXREGVAR; 29 int regnum[] = { 10, 9, 8, 7, 6 } ; 30 31 ftnint intcon[14] = 32 { 2, 2, 2, 2, 33 15, 31, 24, 56, 34 -128, -128, 127, 127, 35 0x7FFF, 0x7FFFFFFF }; 36 37 #if HERE == VAX || HERE == TAHOE 38 /* then put in constants in hex */ 39 short realcon[6][4] = 40 { 41 { 0x80, 0, 0, 0 }, 42 { 0x80, 0, 0, 0 }, 43 { 0x7FFF, 0xFFFF, 0, 0 }, 44 { 0x7FFF, 0xFFFF, 0xFFFF, 0xFFFF }, 45 { 0x3480, 0, 0, 0 }, 46 { 0x2480, 0, 0, 0 }, 47 }; 48 #else 49 double realcon[6] = 50 { 51 2.9387358771e-39, /* 2 ** -128 */ 52 2.938735877055718800e-39, /* 2 ** -128 */ 53 1.7014117332e+38, /* 2**127 * (1 - 2**-24) */ 54 1.701411834604692250e+38, /* 2**127 * (1 - 2**-56) */ 55 5.960464e-8, /* 2 ** -24 */ 56 1.38777878078144567e-17, /* 2 ** -56 */ 57 }; 58 #endif 59 60 /* 61 * The VAX assembler has a serious and not easily fixable problem 62 * with generating instructions that contain expressions of the form 63 * label1-label2 where there are .align's in-between the labels. 64 * Therefore, the compiler must keep track of the offsets and output 65 * .space where needed. 66 */ 67 LOCAL int i_offset; /* initfile offset */ 68 LOCAL int a_offset; /* asmfile offset */ 69 70 prsave(proflab) 71 int proflab; 72 { 73 if(profileflag) 74 { 75 fprintf(asmfile, "\t.align\t2\n"); 76 fprintf(asmfile, "L%d:\t.long\t0\n", proflab); 77 p2pi("\tpushl\t$L%d", proflab); 78 p2pass("\tcallf\t$8,mcount"); 79 } 80 p2pi("\tsubl3\t$LF%d,fp,sp", procno); 81 } 82 83 goret(type) 84 int type; 85 { 86 register int r = 0; 87 switch(type) { /* from retval */ 88 case TYDREAL: 89 r++; 90 91 case TYLOGICAL: 92 case TYADDR: 93 case TYSHORT: 94 case TYLONG: 95 case TYREAL: 96 r++; 97 98 case TYCHAR: 99 case TYCOMPLEX: 100 case TYDCOMPLEX: 101 break; 102 case TYSUBR: 103 if (substars) r++; 104 break; 105 default: 106 badtype("goret", type); 107 } 108 p2pi("\tret#%d", r); 109 } 110 111 /* 112 * move argument slot arg1 (relative to fp) 113 * to slot arg2 (relative to ARGREG) 114 */ 115 mvarg(type, arg1, arg2) 116 int type, arg1, arg2; 117 { 118 p2pij("\tmovl\t%d(fp),%d(fp)", arg1+ARGOFFSET, arg2+argloc); 119 } 120 121 prlabel(fp, k) 122 FILEP fp; 123 int k; 124 { 125 fprintf(fp, "L%d:\n", k); 126 } 127 128 prconi(fp, type, n) 129 FILEP fp; 130 int type; 131 ftnint n; 132 { 133 register int i; 134 135 if(type == TYSHORT) 136 { 137 fprintf(fp, "\t.word\t%ld\n", n); 138 i = SZSHORT; 139 } 140 else 141 { 142 fprintf(fp, "\t.long\t%ld\n", n); 143 i = SZLONG; 144 } 145 if(fp == initfile) 146 i_offset += i; 147 else 148 a_offset += i; 149 } 150 151 prcona(fp, a) 152 FILEP fp; 153 ftnint a; 154 { 155 fprintf(fp, "\t.long\tL%ld\n", a); 156 if(fp == initfile) 157 i_offset += SZLONG; 158 else 159 a_offset += SZLONG; 160 } 161 162 prconr(fp, type, x) 163 FILEP fp; 164 int type; 165 double x; 166 { 167 /* 168 fprintf(fp, "\t%s\t0f%e\n", (type==TYREAL ? ".float" : ".double"), x); 169 */ 170 /* non-portable cheat to preserve bit patterns */ 171 /* this code should be the same for PDP, VAX and Tahoe */ 172 173 register struct sh4 { 174 unsigned short sh[4]; 175 } *cheat; 176 register int i; 177 178 cheat = (struct sh4 *)&x; 179 if(type == TYREAL) { /* force rounding */ 180 float f; 181 f = x; 182 x = f; 183 } 184 fprintf(fp, " .long 0x%04x%04x", cheat->sh[0], cheat->sh[1]); 185 if(type == TYDREAL) { 186 fprintf(fp, ", 0x%04x%04x", cheat->sh[2], cheat->sh[3]); 187 fprintf(fp, " # .double %.17g\n", x); 188 i = SZDOUBLE; 189 } 190 else 191 { 192 fprintf(fp, " # .float %.8g\n", x); 193 i = SZFLOAT; 194 } 195 if(fp == initfile) 196 i_offset += i; 197 else 198 a_offset += i; 199 } 200 201 praddr(fp, stg, varno, offset) 202 FILE *fp; 203 int stg, varno; 204 ftnint offset; 205 { 206 char *memname(); 207 208 if(stg == STGNULL) 209 fprintf(fp, "\t.long\t0\n"); 210 else 211 { 212 fprintf(fp, "\t.long\t%s", memname(stg,varno)); 213 if(offset) 214 fprintf(fp, "+%ld", offset); 215 fprintf(fp, "\n"); 216 } 217 if(fp == initfile) 218 i_offset += SZADDR; 219 else 220 a_offset += SZADDR; 221 } 222 pralign(k) 223 int k; 224 { 225 register int lg; 226 227 if (k > 4) 228 lg = 3; 229 else if (k > 2) 230 lg = 2; 231 else if (k > 1) 232 lg = 1; 233 else 234 return; 235 fprintf(initfile, "\t.align\t%d\n", lg); 236 i_offset += lg; 237 return; 238 } 239 240 241 242 prspace(n) 243 int n; 244 { 245 246 fprintf(initfile, "\t.space\t%d\n", n); 247 i_offset += n; 248 } 249 250 251 preven(k) 252 int k; 253 { 254 register int lg; 255 256 if(k > 4) 257 lg = 3; 258 else if(k > 2) 259 lg = 2; 260 else if(k > 1) 261 lg = 1; 262 else 263 return; 264 fprintf(asmfile, "\t.align\t%d\n", lg); 265 a_offset += lg; 266 } 267 268 praspace(n) 269 int n; 270 { 271 272 fprintf(asmfile, "\t.space\t%d\n", n); 273 a_offset += n; 274 } 275 276 277 casegoto(index, nlab, labs) 278 expptr index; 279 register int nlab; 280 struct Labelblock *labs[]; 281 { 282 register int i; 283 register int arrlab; 284 285 putforce(TYINT, index); 286 p2pi("\tcasel\tr0,$1,$%d\n\t.align 1", nlab-1); 287 p2pi("L%d:", arrlab = newlabel() ); 288 for(i = 0; i< nlab ; ++i) 289 if( labs[i] ) 290 p2pij("\t.word\tL%d-L%d", labs[i]->labelno, arrlab); 291 } 292 293 294 prarif(p, neg, zer, pos) 295 expptr p; 296 int neg, zer, pos; 297 { 298 putforce(p->headblock.vtype, p); 299 p2pass("\ttstl\tr0"); 300 p2pi("\tjlss\tL%d", neg); 301 p2pi("\tjeql\tL%d", zer); 302 p2pi("\tjbr\tL%d", pos); 303 } 304 305 char *memname(stg, mem) 306 int stg, mem; 307 { 308 static char s[20]; 309 310 switch(stg) 311 { 312 case STGEXT: 313 case STGINTR: 314 if(extsymtab[mem].extname[0] == '@') { /* function opcodes */ 315 strcpy(s, varstr(XL, extsymtab[mem].extname)); 316 break; 317 } 318 case STGCOMMON: 319 sprintf(s, "_%s", varstr(XL, extsymtab[mem].extname) ); 320 break; 321 322 case STGBSS: 323 case STGINIT: 324 sprintf(s, "v.%d", mem); 325 break; 326 327 case STGCONST: 328 sprintf(s, "L%d", mem); 329 break; 330 331 case STGEQUIV: 332 sprintf(s, "q.%d", mem+eqvstart); 333 break; 334 335 default: 336 badstg("memname", stg); 337 } 338 return(s); 339 } 340 341 prlocvar(s, len) 342 char *s; 343 ftnint len; 344 { 345 int sz; 346 sz = len; 347 if (sz % SZINT) 348 sz += SZINT - (sz % SZINT); 349 fprintf(asmfile, "\t.lcomm\t%s,%ld\n", s, sz); 350 } 351 352 char * 353 packbytes(cp) 354 register Constp cp; 355 { 356 #if HERE == VAX 357 static char shrt[16]; 358 static char lng[4]; 359 #endif 360 361 switch (cp->vtype) 362 { 363 #if HERE == TAHOE 364 case TYSHORT: 365 { static short shrt; 366 shrt = cp->constant.ci; 367 return ((char *)&shrt); 368 } 369 case TYLONG: 370 case TYLOGICAL: 371 case TYREAL: 372 case TYDREAL: 373 case TYDCOMPLEX: 374 return ((char *)&cp->constant); 375 case TYCOMPLEX: 376 { static float quad[2]; 377 quad[0] = cp->constant.cd[0]; 378 quad[1] = cp->constant.cd[1]; 379 return ((char *)quad); 380 } 381 #endif 382 383 #if HERE == VAX 384 case TYLONG: 385 case TYLOGICAL: 386 swab4((char *)&cp->constant.ci, lng, 4); 387 return (lng); 388 389 case TYSHORT: 390 case TYREAL: 391 case TYDREAL: 392 case TYDCOMPLEX: 393 swab((char *)cp->constant.cd, shrt, typesize[cp->vtype]); 394 return (shrt); 395 case TYCOMPLEX: 396 swab((char *)cp->constant.cd, shrt, 4); 397 swab((char *)&(cp->constant.cd[1]), &shrt[4], 4); 398 return (shrt); 399 #endif 400 401 default: 402 badtype("packbytes", cp->vtype); 403 } 404 } 405 406 #if HERE == VAX 407 /* correct the byte order in longs */ 408 LOCAL swab4(from, to, n) 409 register char *to, *from; 410 register int n; 411 { 412 while(n >= 4) { 413 *to++ = from[3]; 414 *to++ = from[2]; 415 *to++ = from[1]; 416 *to++ = from[0]; 417 from += 4; 418 n -= 4; 419 } 420 while(n >= 2) { 421 *to++ = from[1]; 422 *to++ = from[0]; 423 from += 2; 424 n -= 2; 425 } 426 if(n > 0) 427 *to = *from; 428 } 429 #endif 430 431 prsdata(s, len) 432 register char *s; /* must be aligned if HERE==TAHOE */ 433 register int len; 434 { 435 static char longfmt[] = "\t.long\t0x%x\n"; 436 static char wordfmt[] = "\t.word\t0x%x\n"; 437 static char bytefmt[] = "\t.byte\t0x%x\n"; 438 439 register int i; 440 #if HERE == VAX 441 char quad[8]; 442 swab4(s, quad, len); 443 s = quad; 444 #endif 445 446 i = 0; 447 if ((len - i) >= 4) 448 { 449 fprintf(initfile, longfmt, *((int *) s)); 450 i += 4; 451 } 452 if ((len - i) >= 2) 453 { 454 fprintf(initfile, wordfmt, 0xffff & (*((short *) (s + i)))); 455 i += 2; 456 } 457 if ((len - i) > 0) 458 fprintf(initfile,bytefmt, 0xff & s[i]); 459 460 i_offset += len; 461 return; 462 } 463 464 prquad(s) 465 register long *s; 466 { 467 static char quadfmt1[] = "\t.quad\t0x%x\n"; 468 static char quadfmt2[] = "\t.quad\t0x%x%08x\n"; 469 #if HERE == VAX 470 char quad[8]; 471 swab4((char *)s, quad, 8); 472 s = (long *)quad; 473 #endif 474 475 if (s[0] == 0 ) 476 fprintf(initfile, quadfmt1, s[1]); 477 else 478 fprintf(initfile, quadfmt2, s[0], s[1]); 479 480 return; 481 } 482 483 #ifdef UCBVAXASM 484 prfill(n, s) 485 int n; 486 register long *s; 487 { 488 static char fillfmt1[] = "\t.fill\t%d,8,0x%x\n"; 489 static char fillfmt2[] = "\t.fill\t%d,8,0x%x%08x\n"; 490 #if HERE == VAX 491 char quad[8]; 492 swab4((char *)s, quad, 8); 493 s = (long *)quad; 494 #endif 495 496 if (s[0] == 0 ) 497 fprintf(initfile, fillfmt1, n, s[1]); 498 else 499 fprintf(initfile, fillfmt2, n, s[0], s[1]); 500 501 return; 502 } 503 #endif 504 505 prext(ep) 506 register struct Extsym *ep; 507 { 508 static char globlfmt[] = "\t.globl\t_%s\n"; 509 static char commfmt[] = "\t.comm\t_%s,%ld\n"; 510 static char align2fmt[] = "\t.align\t2\n"; 511 static char labelfmt[] = "_%s:\n"; 512 513 static char seekerror[] = "seek error on tmp file"; 514 static char readerror[] = "read error on tmp file"; 515 516 char *tag; 517 register int leng; 518 long pos; 519 register char *p; 520 long oldvalue[2]; 521 long newvalue[2]; 522 register int n; 523 register int repl; 524 525 tag = varstr(XL, ep->extname); 526 leng = ep->maxleng; 527 528 if (leng == 0) 529 { 530 if(*tag != '@') /* function opcodes */ 531 fprintf(asmfile, globlfmt, tag); 532 return; 533 } 534 535 if (ep->init == NO) 536 { 537 fprintf(asmfile, commfmt, tag, leng); 538 return; 539 } 540 541 fprintf(asmfile, globlfmt, tag); 542 fprintf(initfile, align2fmt); 543 fprintf(initfile, labelfmt, tag); 544 545 pos = lseek(cdatafile, ep->initoffset, 0); 546 if (pos == -1) 547 { 548 err(seekerror); 549 done(1); 550 } 551 552 oldvalue[0] = 0; 553 oldvalue[1] = 0; 554 n = read(cdatafile, oldvalue, 8); 555 if (n < 0) 556 { 557 err(readerror); 558 done(1); 559 } 560 561 if (leng <= 8) 562 { 563 p = (char *)oldvalue + leng; 564 while (p > (char *)oldvalue && *--p == '\0') /* SKIP */; 565 if (*p == '\0') 566 prspace(leng); 567 else if (leng == 8) 568 prquad(oldvalue); 569 else 570 prsdata(oldvalue, leng); 571 572 return; 573 } 574 575 repl = 1; 576 leng -= 8; 577 578 while (leng >= 8) 579 { 580 newvalue[0] = 0; 581 newvalue[1] = 0; 582 583 n = read(cdatafile, newvalue, 8); 584 if (n < 0) 585 { 586 err(readerror); 587 done(1); 588 } 589 590 leng -= 8; 591 592 if (oldvalue[0] == newvalue[0] 593 && oldvalue[1] == newvalue[1]) 594 repl++; 595 else 596 { 597 if (oldvalue[0] == 0 598 && oldvalue[1] == 0) 599 prspace(8*repl); 600 else if (repl == 1) 601 prquad(oldvalue); 602 else 603 #ifdef UCBVAXASM 604 prfill(repl, oldvalue); 605 #else 606 { 607 while (repl-- > 0) 608 prquad(oldvalue); 609 } 610 #endif 611 oldvalue[0] = newvalue[0]; 612 oldvalue[1] = newvalue[1]; 613 repl = 1; 614 } 615 } 616 617 newvalue[0] = 0; 618 newvalue[1] = 0; 619 620 if (leng > 0) 621 { 622 n = read(cdatafile, newvalue, leng); 623 if (n < 0) 624 { 625 err(readerror); 626 done(1); 627 } 628 } 629 630 if (oldvalue[1] == 0 631 && oldvalue[0] == 0 632 && newvalue[1] == 0 633 && newvalue[0] == 0) 634 { 635 prspace(8*repl + leng); 636 return; 637 } 638 639 if (oldvalue[1] == 0 640 && oldvalue[0] == 0) 641 prspace(8*repl); 642 else if (repl == 1) 643 prquad(oldvalue); 644 else 645 #ifdef UCBVAXASM 646 prfill(repl, oldvalue); 647 #else 648 { 649 while (repl-- > 0) 650 prquad(oldvalue); 651 } 652 #endif 653 654 prsdata(newvalue, leng); 655 656 return; 657 } 658 659 prlocdata(sname, leng, type, initoffset, inlcomm) 660 char *sname; 661 ftnint leng; 662 int type; 663 long initoffset; 664 char *inlcomm; 665 { 666 static char seekerror[] = "seek error on tmp file"; 667 static char readerror[] = "read error on tmp file"; 668 669 static char labelfmt[] = "%s:\n"; 670 671 register int k; 672 register char *p; 673 register int repl; 674 register int first; 675 register long pos; 676 register long n; 677 long oldvalue[2]; 678 long newvalue[2]; 679 680 *inlcomm = NO; 681 682 k = leng; 683 first = YES; 684 685 pos = lseek(vdatafile, initoffset, 0); 686 if (pos == -1) 687 { 688 err(seekerror); 689 done(1); 690 } 691 692 oldvalue[0] = 0; 693 oldvalue[1] = 0; 694 n = read(vdatafile, oldvalue, 8); 695 if (n < 0) 696 { 697 err(readerror); 698 done(1); 699 } 700 701 if (k <= 8) 702 { 703 p = (char *)oldvalue + k; 704 while (p > (char *)oldvalue && *--p == '\0') 705 /* SKIP */ ; 706 if (*p == '\0') 707 { 708 if (SMALLVAR(leng)) 709 { 710 pralign(typealign[type]); 711 fprintf(initfile, labelfmt, sname); 712 prspace(leng); 713 } 714 else 715 { 716 preven(ALIDOUBLE); 717 prlocvar(sname, leng); 718 *inlcomm = YES; 719 } 720 } 721 else 722 { 723 fprintf(initfile, labelfmt, sname); 724 if (leng == 8) 725 prquad(oldvalue); 726 else 727 prsdata(oldvalue, leng); 728 } 729 return; 730 } 731 732 repl = 1; 733 k -= 8; 734 735 while (k >=8) 736 { 737 newvalue[0] = 0; 738 newvalue[1] = 0; 739 740 n = read(vdatafile, newvalue, 8); 741 if (n < 0) 742 { 743 err(readerror); 744 done(1); 745 } 746 747 k -= 8; 748 749 if (oldvalue[0] == newvalue[0] 750 && oldvalue[1] == newvalue[1]) 751 repl++; 752 else 753 { 754 if (first == YES) 755 { 756 pralign(typealign[type]); 757 fprintf(initfile, labelfmt, sname); 758 first = NO; 759 } 760 761 if (oldvalue[0] == 0 762 && oldvalue[1] == 0) 763 prspace(8*repl); 764 else 765 { 766 while (repl-- > 0) 767 prquad(oldvalue); 768 } 769 oldvalue[0] = newvalue[0]; 770 oldvalue[1] = newvalue[1]; 771 repl = 1; 772 } 773 } 774 775 newvalue[0] = 0; 776 newvalue[1] = 0; 777 778 if (k > 0) 779 { 780 n = read(vdatafile, newvalue, k); 781 if (n < 0) 782 { 783 err(readerror); 784 done(1); 785 } 786 } 787 788 if (oldvalue[1] == 0 789 && oldvalue[0] == 0 790 && newvalue[1] == 0 791 && newvalue[0] == 0) 792 { 793 if (first == YES && !SMALLVAR(leng)) 794 { 795 prlocvar(sname, leng); 796 *inlcomm = YES; 797 } 798 else 799 { 800 if (first == YES) 801 { 802 pralign(typealign[type]); 803 fprintf(initfile, labelfmt, sname); 804 } 805 prspace(8*repl + k); 806 } 807 return; 808 } 809 810 if (first == YES) 811 { 812 pralign(typealign[type]); 813 fprintf(initfile, labelfmt, sname); 814 } 815 816 if (oldvalue[1] == 0 817 && oldvalue[0] == 0) 818 prspace(8*repl); 819 else 820 { 821 while (repl-- > 0) 822 prquad(oldvalue); 823 } 824 825 prsdata(newvalue, k); 826 827 return; 828 } 829 830 prendproc() 831 { 832 } 833 834 prtail() 835 { 836 } 837 838 prolog(ep, argvec) 839 struct Entrypoint *ep; 840 Addrp argvec; 841 { 842 int i, argslot, proflab; 843 int size; 844 register chainp p; 845 register Namep q; 846 register struct Dimblock *dp; 847 expptr tp; 848 static char maskfmt[] = "\t.word\tLWM%d"; 849 static char align1fmt[] = "\t.align\t1"; 850 851 if(procclass == CLMAIN) { 852 if(fudgelabel) 853 { 854 if(ep->entryname) { 855 p2pass(align1fmt); 856 p2ps("_%s:", varstr(XL, ep->entryname->extname)); 857 p2pi(maskfmt, procno); 858 } 859 putlabel(fudgelabel); 860 fudgelabel = 0; 861 } 862 else 863 { 864 p2pass(align1fmt); 865 p2pass( "_MAIN_:" ); 866 if(ep->entryname == NULL) 867 p2pi(maskfmt, procno); 868 } 869 870 } else if(ep->entryname) 871 if(fudgelabel) 872 { 873 putlabel(fudgelabel); 874 fudgelabel = 0; 875 } 876 else 877 { 878 p2pass(align1fmt); 879 p2ps("_%s:", varstr(XL, ep->entryname->extname)); 880 p2pi(maskfmt, procno); 881 prsave(newlabel()); 882 } 883 884 if(procclass == CLBLOCK) 885 return; 886 if (anylocals == YES) 887 p2pi("\tmovl\t$v.%d,r11", bsslabel); 888 if(argvec) 889 { 890 if (argvec->tag != TADDR) badtag ("prolog",argvec->tag); 891 argloc = argvec->memoffset->constblock.constant.ci + SZINT; 892 /* first slot holds count */ 893 if(proctype == TYCHAR) 894 { 895 mvarg(TYADDR, 0, chslot); 896 mvarg(TYLENG, SZADDR, chlgslot); 897 argslot = SZADDR + SZLENG; 898 } 899 else if( ISCOMPLEX(proctype) ) 900 { 901 mvarg(TYADDR, 0, cxslot); 902 argslot = SZADDR; 903 } 904 else 905 argslot = 0; 906 907 for(p = ep->arglist ; p ; p =p->nextp) 908 { 909 q = (Namep) (p->datap); 910 mvarg(TYADDR, argslot, q->vardesc.varno); 911 argslot += SZADDR; 912 } 913 for(p = ep->arglist ; p ; p = p->nextp) 914 { 915 q = (Namep) (p->datap); 916 if(q->vtype==TYCHAR && q->vclass!=CLPROC) 917 { 918 if(q->vleng && ! ISCONST(q->vleng) ) 919 mvarg(TYLENG, argslot, 920 q->vleng->addrblock.memno); 921 argslot += SZLENG; 922 } 923 } 924 if ((ep->enamep->vtype == TYCOMPLEX) && (!ep->arglist)) 925 p2pass("\tmovl\tfp,r12"); 926 else 927 p2pi("\tsubl3\t$%d,fp,r12", ARGOFFSET-argloc); 928 } else 929 if((ep->arglist) || (ISCOMPLEX(proctype)) || (proctype == TYCHAR)) 930 p2pass("\tmovl\tfp,r12"); 931 932 for(p = ep->arglist ; p ; p = p->nextp) 933 { 934 q = (Namep) (p->datap); 935 if(dp = q->vdim) 936 { 937 for(i = 0 ; i < dp->ndim ; ++i) 938 if(dp->dims[i].dimexpr) 939 puteq( fixtype(cpexpr(dp->dims[i].dimsize)), 940 fixtype(cpexpr(dp->dims[i].dimexpr))); 941 #ifdef SDB 942 if(sdbflag) { 943 for(i = 0 ; i < dp->ndim ; ++i) { 944 if(dp->dims[i].lbaddr) 945 puteq( fixtype(cpexpr(dp->dims[i].lbaddr)), 946 fixtype(cpexpr(dp->dims[i].lb))); 947 if(dp->dims[i].ubaddr) 948 puteq( fixtype(cpexpr(dp->dims[i].ubaddr)), 949 fixtype(cpexpr(dp->dims[i].ub))); 950 951 } 952 } 953 #endif 954 size = typesize[ q->vtype ]; 955 if(q->vtype == TYCHAR) 956 if( ISICON(q->vleng) ) 957 size *= q->vleng->constblock.constant.ci; 958 else 959 size = -1; 960 961 /* on TAHOE, get more efficient subscripting if subscripts 962 have zero-base, so fudge the argument pointers for arrays. 963 Not done if array bounds are being checked. 964 */ 965 if(dp->basexpr) 966 puteq( cpexpr(fixtype(dp->baseoffset)), 967 cpexpr(fixtype(dp->basexpr))); 968 #ifdef SDB 969 if( (! checksubs) && (! sdbflag) ) 970 #else 971 if(! checksubs) 972 #endif 973 { 974 if(dp->basexpr) 975 { 976 if(size > 0) 977 tp = (expptr) ICON(size); 978 else 979 tp = (expptr) cpexpr(q->vleng); 980 putforce(TYINT, 981 fixtype( mkexpr(OPSTAR, tp, 982 cpexpr(dp->baseoffset)) )); 983 p2pi("\tsubl2\tr0,%d(r12)", 984 p->datap->nameblock.vardesc.varno + 985 ARGOFFSET); 986 } 987 else if(dp->baseoffset->constblock.constant.ci != 0) 988 { 989 if(size > 0) 990 { 991 p2pij("\tsubl2\t$%ld,%d(r12)", 992 dp->baseoffset->constblock.constant.ci * size, 993 p->datap->nameblock.vardesc.varno + 994 ARGOFFSET); 995 } 996 else { 997 putforce(TYINT, mkexpr(OPSTAR, cpexpr(dp->baseoffset), 998 cpexpr(q->vleng) )); 999 p2pi("\tsubl2\tr0,%d(r12)", 1000 p->datap->nameblock.vardesc.varno + 1001 ARGOFFSET); 1002 } 1003 } 1004 } 1005 } 1006 } 1007 1008 if(typeaddr) 1009 puteq( cpexpr(typeaddr), mkaddcon(ep->typelabel) ); 1010 /* replace to avoid long jump problem 1011 putgoto(ep->entrylabel); 1012 */ 1013 p2pi("\tjbr\tL%d", ep->entrylabel); 1014 } 1015 1016 prhead(fp) 1017 FILEP fp; 1018 { 1019 #if FAMILY==PCC 1020 p2triple(PCCF_FLBRAC, ARGREG-highregvar, procno); 1021 p2word( (long) (BITSPERCHAR*autoleng) ); 1022 p2flush(); 1023 #endif 1024 } 1025