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