|
|
1.1 ! root 1: #include "defs" ! 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 "pccdefs" ! 12: ! 13: /* ! 14: TAHOE - SPECIFIC ROUTINES ! 15: */ ! 16: ! 17: ! 18: int maxregvar = MAXREGVAR; ! 19: int regnum[] = { 11, 10, 9, 8, 7, 6 } ; ! 20: ! 21: ftnint intcon[14] = ! 22: { 2, 2, 2, 2, ! 23: 15, 31, 24, 56, ! 24: -128, -128, 127, 127, ! 25: 0x7FFF, 0x7FFFFFFF }; ! 26: ! 27: #if HERE == VAX || HERE == TAHOE ! 28: /* then put in constants in hex */ ! 29: short realcon[6][4] = ! 30: { ! 31: { 0x80, 0, 0, 0 }, ! 32: { 0x80, 0, 0, 0 }, ! 33: { 0x7FFF, 0xFFFF, 0, 0 }, ! 34: { 0x7FFF, 0xFFFF, 0xFFFF, 0xFFFF }, ! 35: { 0x3480, 0, 0, 0 }, ! 36: { 0x2480, 0, 0, 0 }, ! 37: }; ! 38: #else ! 39: double realcon[6] = ! 40: { ! 41: 2.9387358771e-39, /* 2 ^ -128 */ ! 42: 2.938735877055718800e-39, /* 2 ^ -128 */ ! 43: 1.7014117332e+38, /* 2^127*(1-2^-24) */ ! 44: 1.701411834604692250e+38, /* 2^127*(1-2^-56) */ ! 45: 5.960464e-8, /* 2 ^ -24 */ ! 46: 1.38777878078144567e-17, /* 2 ^ -56 */ ! 47: }; ! 48: #endif ! 49: ! 50: ! 51: ! 52: ! 53: prsave(proflab) ! 54: int proflab; ! 55: { ! 56: if(profileflag) ! 57: { ! 58: fprintf(asmfile, "L%d:\t.space\t4\n", proflab); ! 59: p2pi("\tpushl\t$L%d", proflab); ! 60: p2pass("\tcallf\t$8,mcount"); ! 61: } ! 62: p2pi("\tsubl3\t$LF%d,fp,sp", procno); ! 63: } ! 64: ! 65: ! 66: ! 67: goret(type) ! 68: int type; ! 69: { ! 70: p2pass("\tret"); ! 71: } ! 72: ! 73: ! 74: ! 75: ! 76: /* ! 77: * move argument slot arg1 (relative to ap) ! 78: * to slot arg2 (relative to ARGREG) ! 79: */ ! 80: ! 81: mvarg(type, arg1, arg2) ! 82: int type, arg1, arg2; ! 83: { ! 84: p2pij("\tmovl\t%d(fp),%d(fp)", arg1+ARGOFFSET, arg2+argloc); ! 85: } ! 86: ! 87: ! 88: ! 89: ! 90: prlabel(fp, k) ! 91: FILEP fp; ! 92: int k; ! 93: { ! 94: fprintf(fp, "L%d:\n", k); ! 95: } ! 96: ! 97: ! 98: ! 99: prconi(fp, type, n) ! 100: FILEP fp; ! 101: int type; ! 102: ftnint n; ! 103: { ! 104: fprintf(fp, "\t%s\t%ld\n", (type==TYSHORT ? ".word" : ".long"), n); ! 105: } ! 106: ! 107: ! 108: ! 109: prcona(fp, a) ! 110: FILEP fp; ! 111: ftnint a; ! 112: { ! 113: fprintf(fp, "\t.long\tL%ld\n", a); ! 114: } ! 115: ! 116: ! 117: ! 118: prconr(fp, type, x) ! 119: FILEP fp; ! 120: int type; ! 121: double x; ! 122: { ! 123: /* ! 124: fprintf(fp, "\t%s\t0f%e\n", (type==TYREAL ? ".float" : ".double"), x); ! 125: */ ! 126: /* non-portable cheat to preserve bit patterns */ ! 127: /* this code should be the same for PDP, VAX and Tahoe */ ! 128: ! 129: register struct sh4 { ! 130: unsigned short sh[4]; ! 131: } *cheat; ! 132: ! 133: cheat = (struct sh4 *)&x; ! 134: fprintf(fp, " .long 0x%04x%04x", cheat->sh[0], cheat->sh[1]); ! 135: if(type == TYDREAL) { ! 136: fprintf(fp, ", 0x%04x%04x", cheat->sh[2], cheat->sh[3]); ! 137: fprintf(fp, " # .double %.17g\n", x); ! 138: } else ! 139: fprintf(fp, " # .float %.7g\n", x); ! 140: } ! 141: ! 142: ! 143: ! 144: praddr(fp, stg, varno, offset) ! 145: FILE *fp; ! 146: int stg, varno; ! 147: ftnint offset; ! 148: { ! 149: char *memname(); ! 150: ! 151: if(stg == STGNULL) ! 152: fprintf(fp, "\t.long\t0\n"); ! 153: else ! 154: { ! 155: fprintf(fp, "\t.long\t%s", memname(stg,varno)); ! 156: if(offset) ! 157: fprintf(fp, "+%ld", offset); ! 158: fprintf(fp, "\n"); ! 159: } ! 160: } ! 161: ! 162: ! 163: ! 164: ! 165: preven(k) ! 166: int k; ! 167: { ! 168: register int lg; ! 169: ! 170: if(k > 4) ! 171: lg = 3; ! 172: else if(k > 2) ! 173: lg = 2; ! 174: else if(k > 1) ! 175: lg = 1; ! 176: else ! 177: return; ! 178: fprintf(asmfile, "\t.align\t%d\n", lg); ! 179: } ! 180: ! 181: ! 182: ! 183: casegoto(index, nlab, labs) ! 184: expptr index; ! 185: register int nlab; ! 186: struct Labelblock *labs[]; ! 187: { ! 188: register int i; ! 189: register int arrlab; ! 190: ! 191: putforce(TYINT, index); ! 192: p2pi("\tcasel\tr0,$1,$%d\n\t.align 1", nlab-1); ! 193: p2pi("L%d:", arrlab = newlabel() ); ! 194: for(i = 0; i< nlab ; ++i) ! 195: if( labs[i] ) ! 196: p2pij("\t.word\tL%d-L%d", labs[i]->labelno, arrlab); ! 197: } ! 198: ! 199: ! 200: prarif(p, neg, zer, pos) ! 201: expptr p; ! 202: int neg, zer, pos; ! 203: { ! 204: putforce(p->headblock.vtype, p); ! 205: p2pass("\ttstl\tr0"); ! 206: p2pi("\tjlss\tL%d", neg); ! 207: p2pi("\tjeql\tL%d", zer); ! 208: p2pi("\tjbr\tL%d", pos); ! 209: } ! 210: ! 211: ! 212: ! 213: ! 214: char *memname(stg, mem) ! 215: int stg, mem; ! 216: { ! 217: static char s[20]; ! 218: ! 219: switch(stg) ! 220: { ! 221: case STGCOMMON: ! 222: case STGEXT: ! 223: sprintf(s, "_%s", varstr(XL, extsymtab[mem].extname) ); ! 224: break; ! 225: ! 226: case STGBSS: ! 227: case STGINIT: ! 228: sprintf(s, "v.%d", mem); ! 229: break; ! 230: ! 231: case STGCONST: ! 232: sprintf(s, "L%d", mem); ! 233: break; ! 234: ! 235: case STGEQUIV: ! 236: sprintf(s, "q.%d", mem+eqvstart); ! 237: break; ! 238: ! 239: default: ! 240: badstg("memname", stg); ! 241: } ! 242: return(s); ! 243: } ! 244: ! 245: ! 246: ! 247: ! 248: prlocvar(s, len) ! 249: char *s; ! 250: ftnint len; ! 251: { ! 252: fprintf(asmfile, "\t.lcomm\t%s,%ld\n", s, roundup(len, ALILONG)); ! 253: } ! 254: ! 255: ! 256: ! 257: prext(name, leng, init) ! 258: char *name; ! 259: ftnint leng; ! 260: int init; ! 261: { ! 262: if(leng == 0) ! 263: fprintf(asmfile, "\t.globl\t_%s\n", name); ! 264: else ! 265: fprintf(asmfile, "\t.comm\t_%s,%ld\n", name, roundup(leng, ALILONG)); ! 266: } ! 267: ! 268: ! 269: ! 270: ! 271: ! 272: prendproc() ! 273: { ! 274: } ! 275: ! 276: ! 277: ! 278: ! 279: prtail() ! 280: { ! 281: } ! 282: ! 283: ! 284: ! 285: ! 286: ! 287: prolog(ep, argvec) ! 288: struct Entrypoint *ep; ! 289: Addrp argvec; ! 290: { ! 291: int i, argslot, proflab; ! 292: int size; ! 293: register chainp p; ! 294: register Namep q; ! 295: register struct Dimblock *dp; ! 296: expptr tp; ! 297: ! 298: if(procclass == CLMAIN) { ! 299: if(fudgelabel) ! 300: { ! 301: if(ep->entryname) { ! 302: p2pass("\t.align\t1"); ! 303: p2ps("_%s:", varstr(XL, ep->entryname->extname)); ! 304: p2pi("\t.word\tLWM%d", procno); ! 305: } ! 306: putlabel(fudgelabel); ! 307: fudgelabel = 0; ! 308: } ! 309: else ! 310: { ! 311: p2pass("\t.align\t1"); ! 312: p2pass( "_MAIN__:" ); ! 313: if(ep->entryname == NULL) ! 314: p2pi("\t.word\tLWM%d", procno); ! 315: } ! 316: ! 317: } else if(ep->entryname) ! 318: if(fudgelabel) ! 319: { ! 320: putlabel(fudgelabel); ! 321: fudgelabel = 0; ! 322: } ! 323: else ! 324: { ! 325: p2pass("\t.align\t1"); ! 326: p2ps("_%s:", varstr(XL, ep->entryname->extname)); ! 327: p2pi("\t.word\tLWM%d", procno); ! 328: prsave(newlabel()); ! 329: } ! 330: ! 331: if(procclass == CLBLOCK) ! 332: return; ! 333: if(argvec) ! 334: { ! 335: argloc = argvec->memoffset->constblock.const.ci + SZINT; ! 336: /* first slot holds count */ ! 337: if(proctype == TYCHAR) ! 338: { ! 339: mvarg(TYADDR, 0, chslot); ! 340: mvarg(TYLENG, SZADDR, chlgslot); ! 341: argslot = SZADDR + SZLENG; ! 342: } ! 343: else if( ISCOMPLEX(proctype) ) ! 344: { ! 345: mvarg(TYADDR, 0, cxslot); ! 346: argslot = SZADDR; ! 347: } ! 348: else ! 349: argslot = 0; ! 350: ! 351: for(p = ep->arglist ; p ; p =p->nextp) ! 352: { ! 353: q = (Namep) (p->datap); ! 354: mvarg(TYADDR, argslot, q->vardesc.varno); ! 355: argslot += SZADDR; ! 356: } ! 357: for(p = ep->arglist ; p ; p = p->nextp) ! 358: { ! 359: q = (Namep) (p->datap); ! 360: if(q->vtype==TYCHAR && q->vclass!=CLPROC) ! 361: { ! 362: if(q->vleng && ! ISCONST(q->vleng) ) ! 363: mvarg(TYLENG, argslot, ! 364: q->vleng->addrblock.memno); ! 365: argslot += SZLENG; ! 366: } ! 367: } ! 368: p2pi("\tsubl3\t$%d,fp,r12", ARGOFFSET-argloc); ! 369: } else ! 370: p2pass("\tmovl\tfp,r12"); ! 371: ! 372: for(p = ep->arglist ; p ; p = p->nextp) ! 373: { ! 374: q = (Namep) (p->datap); ! 375: if(dp = q->vdim) ! 376: { ! 377: for(i = 0 ; i < dp->ndim ; ++i) ! 378: if(dp->dims[i].dimexpr) ! 379: puteq( fixtype(cpexpr(dp->dims[i].dimsize)), ! 380: fixtype(cpexpr(dp->dims[i].dimexpr))); ! 381: size = typesize[ q->vtype ]; ! 382: if(q->vtype == TYCHAR) ! 383: if( ISICON(q->vleng) ) ! 384: size *= q->vleng->constblock.const.ci; ! 385: else ! 386: size = -1; ! 387: ! 388: /* on Tahoe, get more efficient subscripting if subscripts ! 389: have zero-base, so fudge the argument pointers for arrays. ! 390: Not done if array bounds are being checked. ! 391: */ ! 392: if(dp->basexpr) ! 393: puteq( cpexpr(fixtype(dp->baseoffset)), ! 394: cpexpr(fixtype(dp->basexpr))); ! 395: ! 396: if(! checksubs) ! 397: { ! 398: if(dp->basexpr) ! 399: { ! 400: if(size > 0) ! 401: tp = (expptr) ICON(size); ! 402: else ! 403: tp = (expptr) cpexpr(q->vleng); ! 404: putforce(TYINT, ! 405: fixtype( mkexpr(OPSTAR, tp, ! 406: cpexpr(dp->baseoffset)) )); ! 407: p2pi("\tsubl2\tr0,%d(r12)", ! 408: p->datap->nameblock.vardesc.varno + ! 409: ARGOFFSET); ! 410: } ! 411: else if(dp->baseoffset->constblock.const.ci != 0) ! 412: { ! 413: char buff[25]; ! 414: if(size > 0) ! 415: { ! 416: sprintf(buff, "\tsubl2\t$%ld,%d(r12)", ! 417: dp->baseoffset->constblock.const.ci * size, ! 418: p->datap->nameblock.vardesc.varno + ! 419: ARGOFFSET); ! 420: } ! 421: else { ! 422: putforce(TYINT, mkexpr(OPSTAR, cpexpr(dp->baseoffset), ! 423: cpexpr(q->vleng) )); ! 424: sprintf(buff, "\tsubl2\tr0,%d(r12)", ! 425: p->datap->nameblock.vardesc.varno + ! 426: ARGOFFSET); ! 427: } ! 428: p2pass(buff); ! 429: } ! 430: } ! 431: } ! 432: } ! 433: ! 434: if(typeaddr) ! 435: puteq( cpexpr(typeaddr), mkaddcon(ep->typelabel) ); ! 436: putgoto(ep->entrylabel); ! 437: } ! 438: ! 439: ! 440: prhead(fp) ! 441: FILEP fp; ! 442: { ! 443: #if FAMILY==PCC ! 444: p2triple(P2LBRACKET, ARGREG-highregvar, procno); ! 445: p2word( (long) (BITSPERCHAR*autoleng) ); ! 446: p2flush(); ! 447: #endif ! 448: } ! 449: ! 450: ! 451: ! 452: prdbginfo() ! 453: { ! 454: } ! 455: ! 456: #ifdef SDB ! 457: ! 458: ! 459: # ifdef UCBVAXASM ! 460: char *stabdline(code, type) ! 461: int code; ! 462: int type; ! 463: { ! 464: static char buff[30]; ! 465: ! 466: sprintf(buff, "\t.stabd\t0%o,0,0%o\n", code, type); ! 467: return(buff); ! 468: } ! 469: # endif ! 470: ! 471: ! 472: prstab(s, code, type, loc) ! 473: char *s, *loc; ! 474: int code, type; ! 475: { ! 476: char * stabline(); ! 477: ! 478: if(sdbflag) ! 479: fprintf(asmfile, stabline(s,code,type,loc) ); ! 480: } ! 481: ! 482: ! 483: ! 484: char *stabline(s, code, type, loc) ! 485: register char *s; ! 486: int code; ! 487: int type; ! 488: char *loc; ! 489: { ! 490: static char buff[512] = "\t.stab\t\t"; ! 491: register char *t; ! 492: register int i = 0; ! 493: ! 494: #ifdef UCBVAXASM ! 495: t = buff + 8; ! 496: if(s == NULL) ! 497: buff[6] = 'n'; /* .stabn line */ ! 498: else ! 499: { ! 500: buff[6] = 's'; /* .stabs line */ ! 501: *t++ = '"'; ! 502: while(*s!='\0' && *s!=' ') ! 503: { ! 504: #ifndef UCBPASS2 ! 505: if (i == 8) ! 506: break; ! 507: #endif ! 508: *t++ = *s++; ! 509: ++i; ! 510: } ! 511: *t++ = '"'; ! 512: *t++ = ','; ! 513: } ! 514: ! 515: #else ! 516: t = buff + 7; ! 517: if(s) ! 518: while( *s!='\0' && *s!=' ' && i<8 ) ! 519: { ! 520: *t++ = '\''; ! 521: *t++ = *s++; ! 522: *t++ = ','; ! 523: ++i; ! 524: } ! 525: for( ; i<8 ; ++i) ! 526: { ! 527: *t++ = '0'; ! 528: *t++ = ','; ! 529: } ! 530: #endif ! 531: ! 532: ! 533: sprintf(t, "0%o,0,0%o,%s\n", code, type, (loc? loc : "0") ); ! 534: return(buff); ! 535: } ! 536: ! 537: ! 538: ! 539: prstleng(np, leng) ! 540: register Namep np; ! 541: ftnint leng; ! 542: { ! 543: ftnint iarrlen(); ! 544: ! 545: prstab( varstr(VL,np->varname), N_LENG, 0, convic(leng) ); ! 546: } ! 547: ! 548: ! 549: ! 550: stabtype(p) ! 551: register Namep p; ! 552: { ! 553: register int type; ! 554: register int shift; ! 555: type = types2[p->vtype]; ! 556: if(p->vdim) ! 557: { ! 558: type |= 060; /* .stab code for array */ ! 559: shift = 2; ! 560: } ! 561: else if(p->vclass == CLPROC) ! 562: { ! 563: type |= 040; /* .stab code for function */ ! 564: shift = 2; ! 565: } ! 566: else ! 567: shift = 0; ! 568: ! 569: if(p->vstg == STGARG) ! 570: type |= (020 << shift); /* code for pointer-to */ ! 571: ! 572: return(type); ! 573: } ! 574: ! 575: ! 576: ! 577: ! 578: prstssym(np) ! 579: register Namep np; ! 580: { ! 581: prstab(varstr(VL,np->varname), N_SSYM, ! 582: stabtype(np), convic(np->voffset) ); ! 583: } ! 584: #endif
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.