![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to putpcc.c CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 42BSD / old / f77|
Return to putpcc.c CVS log | Up to [CSRG BSD Unix] / 42BSD / old / f77 |
1.1 ! root 1: /* INTERMEDIATE CODE GENERATION FOR S. C. JOHNSON C COMPILERS */ ! 2: /* NEW VERSION USING BINARY POLISH POSTFIX INTERMEDIATE */ ! 3: #if FAMILY != PCC ! 4: WRONG put FILE !!!! ! 5: #endif ! 6: ! 7: #include "defs" ! 8: #include "pccdefs" ! 9: Addrp putcall(), putcxeq(), putcx1(), realpart(); ! 10: expptr imagpart(); ! 11: ftnint lencat(); ! 12: ! 13: #define FOUR 4 ! 14: extern int ops2[]; ! 15: extern int types2[]; ! 16: ! 17: #define P2BUFFMAX 128 ! 18: static long int p2buff[P2BUFFMAX]; ! 19: static long int *p2bufp = &p2buff[0]; ! 20: static long int *p2bufend = &p2buff[P2BUFFMAX]; ! 21: ! 22: ! 23: puthead(s, class) ! 24: char *s; ! 25: int class; ! 26: { ! 27: char buff[100]; ! 28: #if TARGET == VAX ! 29: if(s) ! 30: p2ps("\t.globl\t_%s", s); ! 31: #endif ! 32: /* put out fake copy of left bracket line, to be redone later */ ! 33: if( ! headerdone ) ! 34: { ! 35: #if FAMILY == PCC ! 36: p2flush(); ! 37: #endif ! 38: headoffset = ftell(textfile); ! 39: prhead(textfile); ! 40: headerdone = YES; ! 41: p2triple(P2STMT, (strlen(infname)+FOUR-1)/FOUR, 0); ! 42: p2str(infname); ! 43: #if TARGET == PDP11 ! 44: /* fake jump to start the optimizer */ ! 45: if(class != CLBLOCK) ! 46: putgoto( fudgelabel = newlabel() ); ! 47: #endif ! 48: ! 49: #if TARGET == VAX ! 50: /* jump from top to bottom */ ! 51: if(s!=CNULL && class!=CLBLOCK) ! 52: { ! 53: int proflab = newlabel(); ! 54: p2ps("_%s:", s); ! 55: p2pi("\t.word\tLWM%d", procno); ! 56: prsave(proflab); ! 57: p2pi("\tjmp\tL%d", fudgelabel = newlabel()); ! 58: } ! 59: #endif ! 60: } ! 61: } ! 62: ! 63: ! 64: ! 65: ! 66: ! 67: /* It is necessary to precede each procedure with a "left bracket" ! 68: * line that tells pass 2 how many register variables and how ! 69: * much automatic space is required for the function. This compiler ! 70: * does not know how much automatic space is needed until the ! 71: * entire procedure has been processed. Therefore, "puthead" ! 72: * is called at the begining to record the current location in textfile, ! 73: * then to put out a placeholder left bracket line. This procedure ! 74: * repositions the file and rewrites that line, then puts the ! 75: * file pointer back to the end of the file. ! 76: */ ! 77: ! 78: putbracket() ! 79: { ! 80: long int hereoffset; ! 81: ! 82: #if FAMILY == PCC ! 83: p2flush(); ! 84: #endif ! 85: hereoffset = ftell(textfile); ! 86: if(fseek(textfile, headoffset, 0)) ! 87: fatal("fseek failed"); ! 88: prhead(textfile); ! 89: if(fseek(textfile, hereoffset, 0)) ! 90: fatal("fseek failed 2"); ! 91: } ! 92: ! 93: ! 94: ! 95: ! 96: putrbrack(k) ! 97: int k; ! 98: { ! 99: p2op(P2RBRACKET, k); ! 100: } ! 101: ! 102: ! 103: ! 104: putnreg() ! 105: { ! 106: } ! 107: ! 108: ! 109: ! 110: ! 111: ! 112: ! 113: puteof() ! 114: { ! 115: p2op(P2EOF, 0); ! 116: p2flush(); ! 117: } ! 118: ! 119: ! 120: ! 121: putstmt() ! 122: { ! 123: p2triple(P2STMT, 0, lineno); ! 124: } ! 125: ! 126: ! 127: ! 128: ! 129: /* put out code for if( ! p) goto l */ ! 130: putif(p,l) ! 131: register expptr p; ! 132: int l; ! 133: { ! 134: register int k; ! 135: ! 136: if( ( k = (p = fixtype(p))->headblock.vtype) != TYLOGICAL) ! 137: { ! 138: if(k != TYERROR) ! 139: err("non-logical expression in IF statement"); ! 140: frexpr(p); ! 141: } ! 142: else ! 143: { ! 144: putex1(p); ! 145: p2icon( (long int) l , P2INT); ! 146: p2op(P2CBRANCH, 0); ! 147: putstmt(); ! 148: } ! 149: } ! 150: ! 151: ! 152: ! 153: ! 154: ! 155: /* put out code for goto l */ ! 156: putgoto(label) ! 157: int label; ! 158: { ! 159: p2triple(P2GOTO, 1, label); ! 160: putstmt(); ! 161: } ! 162: ! 163: ! 164: /* branch to address constant or integer variable */ ! 165: putbranch(p) ! 166: register Addrp p; ! 167: { ! 168: putex1(p); ! 169: p2op(P2GOTO, P2INT); ! 170: putstmt(); ! 171: } ! 172: ! 173: ! 174: ! 175: /* put out label l: */ ! 176: putlabel(label) ! 177: int label; ! 178: { ! 179: p2op(P2LABEL, label); ! 180: } ! 181: ! 182: ! 183: ! 184: ! 185: putexpr(p) ! 186: expptr p; ! 187: { ! 188: putex1(p); ! 189: putstmt(); ! 190: } ! 191: ! 192: ! 193: ! 194: ! 195: putcmgo(index, nlab, labs) ! 196: expptr index; ! 197: int nlab; ! 198: struct Labelblock *labs[]; ! 199: { ! 200: int i, labarray, skiplabel; ! 201: ! 202: if(! ISINT(index->headblock.vtype) ) ! 203: { ! 204: execerr("computed goto index must be integer", CNULL); ! 205: return; ! 206: } ! 207: ! 208: #if TARGET == VAX ! 209: /* use special case instruction */ ! 210: vaxgoto(index, nlab, labs); ! 211: #else ! 212: labarray = newlabel(); ! 213: preven(ALIADDR); ! 214: prlabel(asmfile, labarray); ! 215: prcona(asmfile, (ftnint) (skiplabel = newlabel()) ); ! 216: for(i = 0 ; i < nlab ; ++i) ! 217: if( labs[i] ) ! 218: prcona(asmfile, (ftnint)(labs[i]->labelno) ); ! 219: prcmgoto(index, nlab, skiplabel, labarray); ! 220: putlabel(skiplabel); ! 221: #endif ! 222: } ! 223: ! 224: putx(p) ! 225: expptr p; ! 226: { ! 227: char *memname(); ! 228: int opc; ! 229: int ncomma; ! 230: int type, k; ! 231: ! 232: switch(p->tag) ! 233: { ! 234: case TERROR: ! 235: free( (charptr) p ); ! 236: break; ! 237: ! 238: case TCONST: ! 239: switch(type = p->constblock.vtype) ! 240: { ! 241: case TYLOGICAL: ! 242: type = tyint; ! 243: case TYLONG: ! 244: case TYSHORT: ! 245: p2icon(p->constblock.const.ci, types2[type]); ! 246: free( (charptr) p ); ! 247: break; ! 248: ! 249: case TYADDR: ! 250: p2triple(P2ICON, 1, P2INT|P2PTR); ! 251: p2word(0L); ! 252: p2name(memname(STGCONST, ! 253: (int) p->constblock.const.ci) ); ! 254: free( (charptr) p ); ! 255: break; ! 256: ! 257: default: ! 258: putx( putconst(p) ); ! 259: break; ! 260: } ! 261: break; ! 262: ! 263: case TEXPR: ! 264: switch(opc = p->exprblock.opcode) ! 265: { ! 266: case OPCALL: ! 267: case OPCCALL: ! 268: if( ISCOMPLEX(p->exprblock.vtype) ) ! 269: putcxop(p); ! 270: else putcall(p); ! 271: break; ! 272: ! 273: case OPMIN: ! 274: case OPMAX: ! 275: putmnmx(p); ! 276: break; ! 277: ! 278: ! 279: case OPASSIGN: ! 280: if(ISCOMPLEX(p->exprblock.leftp->headblock.vtype) ! 281: || ISCOMPLEX(p->exprblock.rightp->headblock.vtype) ) ! 282: frexpr( putcxeq(p) ); ! 283: else if( ISCHAR(p) ) ! 284: putcheq(p); ! 285: else ! 286: goto putopp; ! 287: break; ! 288: ! 289: case OPEQ: ! 290: case OPNE: ! 291: if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) || ! 292: ISCOMPLEX(p->exprblock.rightp->headblock.vtype) ) ! 293: { ! 294: putcxcmp(p); ! 295: break; ! 296: } ! 297: case OPLT: ! 298: case OPLE: ! 299: case OPGT: ! 300: case OPGE: ! 301: if(ISCHAR(p->exprblock.leftp)) ! 302: { ! 303: putchcmp(p); ! 304: break; ! 305: } ! 306: goto putopp; ! 307: ! 308: case OPPOWER: ! 309: putpower(p); ! 310: break; ! 311: ! 312: case OPSTAR: ! 313: #if FAMILY == PCC ! 314: /* m * (2**k) -> m<<k */ ! 315: if(INT(p->exprblock.leftp->headblock.vtype) && ! 316: ISICON(p->exprblock.rightp) && ! 317: ( (k = log2(p->exprblock.rightp->constblock.const.ci))>0) ) ! 318: { ! 319: p->exprblock.opcode = OPLSHIFT; ! 320: frexpr(p->exprblock.rightp); ! 321: p->exprblock.rightp = ICON(k); ! 322: goto putopp; ! 323: } ! 324: #endif ! 325: ! 326: case OPMOD: ! 327: goto putopp; ! 328: case OPPLUS: ! 329: case OPMINUS: ! 330: case OPSLASH: ! 331: case OPNEG: ! 332: if( ISCOMPLEX(p->exprblock.vtype) ) ! 333: putcxop(p); ! 334: else goto putopp; ! 335: break; ! 336: ! 337: case OPCONV: ! 338: if( ISCOMPLEX(p->exprblock.vtype) ) ! 339: putcxop(p); ! 340: else if( ISCOMPLEX(p->exprblock.leftp->headblock.vtype) ) ! 341: { ! 342: ncomma = 0; ! 343: putx( mkconv(p->exprblock.vtype, ! 344: realpart(putcx1(p->exprblock.leftp, ! 345: &ncomma)))); ! 346: putcomma(ncomma, p->exprblock.vtype, NO); ! 347: free( (charptr) p ); ! 348: } ! 349: else goto putopp; ! 350: break; ! 351: ! 352: case OPNOT: ! 353: case OPOR: ! 354: case OPAND: ! 355: case OPEQV: ! 356: case OPNEQV: ! 357: case OPADDR: ! 358: case OPPLUSEQ: ! 359: case OPSTAREQ: ! 360: case OPCOMMA: ! 361: case OPQUEST: ! 362: case OPCOLON: ! 363: case OPBITOR: ! 364: case OPBITAND: ! 365: case OPBITXOR: ! 366: case OPBITNOT: ! 367: case OPLSHIFT: ! 368: case OPRSHIFT: ! 369: putopp: ! 370: putop(p); ! 371: break; ! 372: ! 373: default: ! 374: badop("putx", opc); ! 375: } ! 376: break; ! 377: ! 378: case TADDR: ! 379: putaddr(p, YES); ! 380: break; ! 381: ! 382: default: ! 383: badtag("putx", p->tag); ! 384: } ! 385: } ! 386: ! 387: ! 388: ! 389: LOCAL putop(p) ! 390: expptr p; ! 391: { ! 392: int k; ! 393: expptr lp, tp; ! 394: int pt, lt; ! 395: int comma; ! 396: ! 397: switch(p->exprblock.opcode) /* check for special cases and rewrite */ ! 398: { ! 399: case OPCONV: ! 400: pt = p->exprblock.vtype; ! 401: lp = p->exprblock.leftp; ! 402: lt = lp->headblock.vtype; ! 403: while(p->tag==TEXPR && p->exprblock.opcode==OPCONV && ! 404: ( (ISREAL(pt)&&ISREAL(lt)) || ! 405: (INT(pt)&&(ONEOF(lt,MSKINT|MSKADDR|MSKCHAR|M(TYSUBR)))) )) ! 406: { ! 407: #if SZINT < SZLONG ! 408: if(lp->tag != TEXPR) ! 409: { ! 410: if(pt==TYINT && lt==TYLONG) ! 411: break; ! 412: if(lt==TYINT && pt==TYLONG) ! 413: break; ! 414: } ! 415: #endif ! 416: ! 417: #if TARGET == VAX ! 418: if(pt==TYDREAL && lt==TYREAL) ! 419: { ! 420: if(lp->tag==TEXPR && ! 421: lp->exprblock.opcode==OPCONV && ! 422: lp->exprblock.leftp->headblock.vtype==TYDREAL) ! 423: { ! 424: putx(lp->exprblock.leftp); ! 425: p2op(P2CONV, P2REAL); ! 426: p2op(P2CONV, P2DREAL); ! 427: free( (charptr) p ); ! 428: return; ! 429: } ! 430: else break; ! 431: } ! 432: #endif ! 433: ! 434: if(lt==TYCHAR && lp->tag==TEXPR && ! 435: lp->exprblock.opcode==OPCALL) ! 436: { ! 437: p->exprblock.leftp = (expptr) putcall(lp); ! 438: putop(p); ! 439: putcomma(1, pt, NO); ! 440: free( (charptr) p ); ! 441: return; ! 442: } ! 443: free( (charptr) p ); ! 444: p = lp; ! 445: pt = lt; ! 446: lp = p->exprblock.leftp; ! 447: lt = lp->headblock.vtype; ! 448: } ! 449: if(p->tag==TEXPR && p->exprblock.opcode==OPCONV) ! 450: break; ! 451: putx(p); ! 452: return; ! 453: ! 454: case OPADDR: ! 455: comma = NO; ! 456: lp = p->exprblock.leftp; ! 457: if(lp->tag != TADDR) ! 458: { ! 459: tp = (expptr) ! 460: mktemp(lp->headblock.vtype,lp->headblock.vleng); ! 461: putx( mkexpr(OPASSIGN, cpexpr(tp), lp) ); ! 462: lp = tp; ! 463: comma = YES; ! 464: } ! 465: putaddr(lp, NO); ! 466: if(comma) ! 467: putcomma(1, TYINT, NO); ! 468: free( (charptr) p ); ! 469: return; ! 470: #if TARGET == VAX ! 471: /* take advantage of a glitch in the code generator that does not check ! 472: the type clash in an assignment or comparison of an integer zero and ! 473: a floating left operand, and generates optimal code for the correct ! 474: type. (The PCC has no floating-constant node to encode this correctly.) ! 475: */ ! 476: case OPASSIGN: ! 477: case OPLT: ! 478: case OPLE: ! 479: case OPGT: ! 480: case OPGE: ! 481: case OPEQ: ! 482: case OPNE: ! 483: if(ISREAL(p->exprblock.leftp->headblock.vtype) && ! 484: ISREAL(p->exprblock.rightp->headblock.vtype) && ! 485: ISCONST(p->exprblock.rightp) && ! 486: p->exprblock.rightp->constblock.const.cd[0]==0) ! 487: { ! 488: p->exprblock.rightp->constblock.vtype = TYINT; ! 489: p->exprblock.rightp->constblock.const.ci = 0; ! 490: } ! 491: #endif ! 492: } ! 493: ! 494: if( (k = ops2[p->exprblock.opcode]) <= 0) ! 495: badop("putop", p->exprblock.opcode); ! 496: putx(p->exprblock.leftp); ! 497: if(p->exprblock.rightp) ! 498: putx(p->exprblock.rightp); ! 499: p2op(k, types2[p->exprblock.vtype]); ! 500: ! 501: if(p->exprblock.vleng) ! 502: frexpr(p->exprblock.vleng); ! 503: free( (charptr) p ); ! 504: } ! 505: ! 506: putforce(t, p) ! 507: int t; ! 508: expptr p; ! 509: { ! 510: p = mkconv(t, fixtype(p)); ! 511: putx(p); ! 512: p2op(P2FORCE, ! 513: (t==TYSHORT ? P2SHORT : (t==TYLONG ? P2LONG : P2DREAL)) ); ! 514: putstmt(); ! 515: } ! 516: ! 517: ! 518: ! 519: LOCAL putpower(p) ! 520: expptr p; ! 521: { ! 522: expptr base; ! 523: Addrp t1, t2; ! 524: ftnint k; ! 525: int type; ! 526: int ncomma; ! 527: ! 528: if(!ISICON(p->exprblock.rightp) || ! 529: (k = p->exprblock.rightp->constblock.const.ci)<2) ! 530: fatal("putpower: bad call"); ! 531: base = p->exprblock.leftp; ! 532: type = base->headblock.vtype; ! 533: t1 = mktemp(type, PNULL); ! 534: t2 = NULL; ! 535: ncomma = 1; ! 536: putassign(cpexpr(t1), cpexpr(base) ); ! 537: ! 538: for( ; (k&1)==0 && k>2 ; k>>=1 ) ! 539: { ! 540: ++ncomma; ! 541: putsteq(t1, t1); ! 542: } ! 543: ! 544: if(k == 2) ! 545: putx( mkexpr(OPSTAR, cpexpr(t1), cpexpr(t1)) ); ! 546: else ! 547: { ! 548: t2 = mktemp(type, PNULL); ! 549: ++ncomma; ! 550: putassign(cpexpr(t2), cpexpr(t1)); ! 551: ! 552: for(k>>=1 ; k>1 ; k>>=1) ! 553: { ! 554: ++ncomma; ! 555: putsteq(t1, t1); ! 556: if(k & 1) ! 557: { ! 558: ++ncomma; ! 559: putsteq(t2, t1); ! 560: } ! 561: } ! 562: putx( mkexpr(OPSTAR, cpexpr(t2), ! 563: mkexpr(OPSTAR, cpexpr(t1), cpexpr(t1)) )); ! 564: } ! 565: putcomma(ncomma, type, NO); ! 566: frexpr(t1); ! 567: if(t2) ! 568: frexpr(t2); ! 569: frexpr(p); ! 570: } ! 571: ! 572: ! 573: ! 574: ! 575: LOCAL Addrp intdouble(p, ncommap) ! 576: Addrp p; ! 577: int *ncommap; ! 578: { ! 579: register Addrp t; ! 580: ! 581: t = mktemp(TYDREAL, PNULL); ! 582: ++*ncommap; ! 583: putassign(cpexpr(t), p); ! 584: return(t); ! 585: } ! 586: ! 587: ! 588: ! 589: ! 590: ! 591: LOCAL Addrp putcxeq(p) ! 592: register expptr p; ! 593: { ! 594: register Addrp lp, rp; ! 595: int ncomma; ! 596: ! 597: if(p->tag != TEXPR) ! 598: badtag("putcxeq", p->tag); ! 599: ! 600: ncomma = 0; ! 601: lp = putcx1(p->exprblock.leftp, &ncomma); ! 602: rp = putcx1(p->exprblock.rightp, &ncomma); ! 603: putassign(realpart(lp), realpart(rp)); ! 604: if( ISCOMPLEX(p->exprblock.vtype) ) ! 605: { ! 606: ++ncomma; ! 607: putassign(imagpart(lp), imagpart(rp)); ! 608: } ! 609: putcomma(ncomma, TYREAL, NO); ! 610: frexpr(rp); ! 611: free( (charptr) p ); ! 612: return(lp); ! 613: } ! 614: ! 615: ! 616: ! 617: LOCAL putcxop(p) ! 618: expptr p; ! 619: { ! 620: Addrp putcx1(); ! 621: int ncomma; ! 622: ! 623: ncomma = 0; ! 624: putaddr( putcx1(p, &ncomma), NO); ! 625: putcomma(ncomma, TYINT, NO); ! 626: } ! 627: ! 628: ! 629: ! 630: LOCAL Addrp putcx1(p, ncommap) ! 631: register expptr p; ! 632: int *ncommap; ! 633: { ! 634: expptr q; ! 635: Addrp lp, rp; ! 636: register Addrp resp; ! 637: int opcode; ! 638: int ltype, rtype; ! 639: expptr mkrealcon(); ! 640: ! 641: if(p == NULL) ! 642: return(NULL); ! 643: ! 644: switch(p->tag) ! 645: { ! 646: case TCONST: ! 647: if( ISCOMPLEX(p->constblock.vtype) ) ! 648: p = (expptr) putconst(p); ! 649: return( (Addrp) p ); ! 650: ! 651: case TADDR: ! 652: if( ! addressable(p) ) ! 653: { ! 654: ++*ncommap; ! 655: resp = mktemp(tyint, PNULL); ! 656: putassign( cpexpr(resp), p->addrblock.memoffset ); ! 657: p->addrblock.memoffset = (expptr)resp; ! 658: } ! 659: return( (Addrp) p ); ! 660: ! 661: case TEXPR: ! 662: if( ISCOMPLEX(p->exprblock.vtype) ) ! 663: break; ! 664: ++*ncommap; ! 665: resp = mktemp(TYDREAL, NO); ! 666: putassign( cpexpr(resp), p); ! 667: return(resp); ! 668: ! 669: default: ! 670: badtag("putcx1", p->tag); ! 671: } ! 672: ! 673: opcode = p->exprblock.opcode; ! 674: if(opcode==OPCALL || opcode==OPCCALL) ! 675: { ! 676: ++*ncommap; ! 677: return( putcall(p) ); ! 678: } ! 679: else if(opcode == OPASSIGN) ! 680: { ! 681: ++*ncommap; ! 682: return( putcxeq(p) ); ! 683: } ! 684: resp = mktemp(p->exprblock.vtype, PNULL); ! 685: if(lp = putcx1(p->exprblock.leftp, ncommap) ) ! 686: ltype = lp->vtype; ! 687: if(rp = putcx1(p->exprblock.rightp, ncommap) ) ! 688: rtype = rp->vtype; ! 689: ! 690: switch(opcode) ! 691: { ! 692: case OPCOMMA: ! 693: frexpr(resp); ! 694: resp = rp; ! 695: rp = NULL; ! 696: break; ! 697: ! 698: case OPNEG: ! 699: putassign( realpart(resp), mkexpr(OPNEG, realpart(lp), ENULL) ); ! 700: putassign( imagpart(resp), mkexpr(OPNEG, imagpart(lp), ENULL) ); ! 701: *ncommap += 2; ! 702: break; ! 703: ! 704: case OPPLUS: ! 705: case OPMINUS: ! 706: putassign( realpart(resp), ! 707: mkexpr(opcode, realpart(lp), realpart(rp) )); ! 708: if(rtype < TYCOMPLEX) ! 709: putassign( imagpart(resp), imagpart(lp) ); ! 710: else if(ltype < TYCOMPLEX) ! 711: { ! 712: if(opcode == OPPLUS) ! 713: putassign( imagpart(resp), imagpart(rp) ); ! 714: else putassign( imagpart(resp), ! 715: mkexpr(OPNEG, imagpart(rp), ENULL) ); ! 716: } ! 717: else ! 718: putassign( imagpart(resp), ! 719: mkexpr(opcode, imagpart(lp), imagpart(rp) )); ! 720: ! 721: *ncommap += 2; ! 722: break; ! 723: ! 724: case OPSTAR: ! 725: if(ltype < TYCOMPLEX) ! 726: { ! 727: if( ISINT(ltype) ) ! 728: lp = intdouble(lp, ncommap); ! 729: putassign( realpart(resp), ! 730: mkexpr(OPSTAR, cpexpr(lp), realpart(rp) )); ! 731: putassign( imagpart(resp), ! 732: mkexpr(OPSTAR, cpexpr(lp), imagpart(rp) )); ! 733: } ! 734: else if(rtype < TYCOMPLEX) ! 735: { ! 736: if( ISINT(rtype) ) ! 737: rp = intdouble(rp, ncommap); ! 738: putassign( realpart(resp), ! 739: mkexpr(OPSTAR, cpexpr(rp), realpart(lp) )); ! 740: putassign( imagpart(resp), ! 741: mkexpr(OPSTAR, cpexpr(rp), imagpart(lp) )); ! 742: } ! 743: else { ! 744: putassign( realpart(resp), mkexpr(OPMINUS, ! 745: mkexpr(OPSTAR, realpart(lp), realpart(rp)), ! 746: mkexpr(OPSTAR, imagpart(lp), imagpart(rp)) )); ! 747: putassign( imagpart(resp), mkexpr(OPPLUS, ! 748: mkexpr(OPSTAR, realpart(lp), imagpart(rp)), ! 749: mkexpr(OPSTAR, imagpart(lp), realpart(rp)) )); ! 750: } ! 751: *ncommap += 2; ! 752: break; ! 753: ! 754: case OPSLASH: ! 755: /* fixexpr has already replaced all divisions ! 756: * by a complex by a function call ! 757: */ ! 758: if( ISINT(rtype) ) ! 759: rp = intdouble(rp, ncommap); ! 760: putassign( realpart(resp), ! 761: mkexpr(OPSLASH, realpart(lp), cpexpr(rp)) ); ! 762: putassign( imagpart(resp), ! 763: mkexpr(OPSLASH, imagpart(lp), cpexpr(rp)) ); ! 764: *ncommap += 2; ! 765: break; ! 766: ! 767: case OPCONV: ! 768: putassign( realpart(resp), realpart(lp) ); ! 769: if( ISCOMPLEX(lp->vtype) ) ! 770: q = imagpart(lp); ! 771: else if(rp != NULL) ! 772: q = (expptr) realpart(rp); ! 773: else ! 774: q = mkrealcon(TYDREAL, 0.0); ! 775: putassign( imagpart(resp), q); ! 776: *ncommap += 2; ! 777: break; ! 778: ! 779: default: ! 780: badop("putcx1", opcode); ! 781: } ! 782: ! 783: frexpr(lp); ! 784: frexpr(rp); ! 785: free( (charptr) p ); ! 786: return(resp); ! 787: } ! 788: ! 789: ! 790: ! 791: ! 792: LOCAL putcxcmp(p) ! 793: register expptr p; ! 794: { ! 795: int opcode; ! 796: int ncomma; ! 797: register Addrp lp, rp; ! 798: expptr q; ! 799: ! 800: if(p->tag != TEXPR) ! 801: badtag("putcxcmp", p->tag); ! 802: ! 803: ncomma = 0; ! 804: opcode = p->exprblock.opcode; ! 805: lp = putcx1(p->exprblock.leftp, &ncomma); ! 806: rp = putcx1(p->exprblock.rightp, &ncomma); ! 807: ! 808: q = mkexpr( opcode==OPEQ ? OPAND : OPOR , ! 809: mkexpr(opcode, realpart(lp), realpart(rp)), ! 810: mkexpr(opcode, imagpart(lp), imagpart(rp)) ); ! 811: putx( fixexpr(q) ); ! 812: putcomma(ncomma, TYINT, NO); ! 813: ! 814: free( (charptr) lp); ! 815: free( (charptr) rp); ! 816: free( (charptr) p ); ! 817: } ! 818: ! 819: LOCAL Addrp putch1(p, ncommap) ! 820: register expptr p; ! 821: int * ncommap; ! 822: { ! 823: register Addrp t; ! 824: Addrp mktemp(); ! 825: Addrp putconst(); ! 826: ! 827: switch(p->tag) ! 828: { ! 829: case TCONST: ! 830: return( putconst(p) ); ! 831: ! 832: case TADDR: ! 833: return( (Addrp) p ); ! 834: ! 835: case TEXPR: ! 836: ++*ncommap; ! 837: ! 838: switch(p->exprblock.opcode) ! 839: { ! 840: expptr q; ! 841: ! 842: case OPCALL: ! 843: case OPCCALL: ! 844: t = putcall(p); ! 845: break; ! 846: ! 847: case OPCONCAT: ! 848: t = mktemp(TYCHAR, ICON(lencat(p)) ); ! 849: q = (expptr) cpexpr(p->headblock.vleng); ! 850: putcat( cpexpr(t), p ); ! 851: /* put the correct length on the block */ ! 852: frexpr(t->vleng); ! 853: t->vleng = q; ! 854: ! 855: break; ! 856: ! 857: case OPCONV: ! 858: if(!ISICON(p->exprblock.vleng) ! 859: || p->exprblock.vleng->constblock.const.ci!=1 ! 860: || ! INT(p->exprblock.leftp->headblock.vtype) ) ! 861: fatal("putch1: bad character conversion"); ! 862: t = mktemp(TYCHAR, ICON(1) ); ! 863: putop( mkexpr(OPASSIGN, cpexpr(t), p) ); ! 864: break; ! 865: default: ! 866: badop("putch1", p->exprblock.opcode); ! 867: } ! 868: return(t); ! 869: ! 870: default: ! 871: badtag("putch1", p->tag); ! 872: } ! 873: /* NOTREACHED */ ! 874: } ! 875: ! 876: ! 877: ! 878: ! 879: LOCAL putchop(p) ! 880: expptr p; ! 881: { ! 882: int ncomma; ! 883: ! 884: ncomma = 0; ! 885: putaddr( putch1(p, &ncomma) , NO ); ! 886: putcomma(ncomma, TYCHAR, YES); ! 887: } ! 888: ! 889: ! 890: ! 891: ! 892: LOCAL putcheq(p) ! 893: register expptr p; ! 894: { ! 895: int ncomma; ! 896: expptr lp, rp; ! 897: ! 898: if(p->tag != TEXPR) ! 899: badtag("putcheq", p->tag); ! 900: ! 901: ncomma = 0; ! 902: lp = p->exprblock.leftp; ! 903: rp = p->exprblock.rightp; ! 904: if( rp->tag==TEXPR && rp->exprblock.opcode==OPCONCAT ) ! 905: putcat(lp, rp); ! 906: else if( ISONE(lp->headblock.vleng) && ISONE(rp->headblock.vleng) ) ! 907: { ! 908: putaddr( putch1(lp, &ncomma) , YES ); ! 909: putaddr( putch1(rp, &ncomma) , YES ); ! 910: putcomma(ncomma, TYINT, NO); ! 911: p2op(P2ASSIGN, P2CHAR); ! 912: } ! 913: else ! 914: { ! 915: putx( call2(TYINT, "s_copy", lp, rp) ); ! 916: putcomma(ncomma, TYINT, NO); ! 917: } ! 918: ! 919: frexpr(p->exprblock.vleng); ! 920: free( (charptr) p ); ! 921: } ! 922: ! 923: ! 924: ! 925: ! 926: LOCAL putchcmp(p) ! 927: register expptr p; ! 928: { ! 929: int ncomma; ! 930: expptr lp, rp; ! 931: ! 932: if(p->tag != TEXPR) ! 933: badtag("putchcmp", p->tag); ! 934: ! 935: ncomma = 0; ! 936: lp = p->exprblock.leftp; ! 937: rp = p->exprblock.rightp; ! 938: ! 939: if(ISONE(lp->headblock.vleng) && ISONE(rp->headblock.vleng) ) ! 940: { ! 941: putaddr( putch1(lp, &ncomma) , YES ); ! 942: putaddr( putch1(rp, &ncomma) , YES ); ! 943: p2op(ops2[p->exprblock.opcode], P2CHAR); ! 944: free( (charptr) p ); ! 945: putcomma(ncomma, TYINT, NO); ! 946: } ! 947: else ! 948: { ! 949: p->exprblock.leftp = call2(TYINT,"s_cmp", lp, rp); ! 950: p->exprblock.rightp = ICON(0); ! 951: putop(p); ! 952: } ! 953: } ! 954: ! 955: ! 956: ! 957: ! 958: ! 959: LOCAL putcat(lhs, rhs) ! 960: register Addrp lhs; ! 961: register expptr rhs; ! 962: { ! 963: int n, ncomma; ! 964: Addrp lp, cp; ! 965: ! 966: ncomma = 0; ! 967: n = ncat(rhs); ! 968: lp = mktmpn(n, TYLENG, PNULL); ! 969: cp = mktmpn(n, TYADDR, PNULL); ! 970: ! 971: n = 0; ! 972: putct1(rhs, lp, cp, &n, &ncomma); ! 973: ! 974: putx( call4(TYSUBR, "s_cat", lhs, cp, lp, mkconv(TYLONG, ICON(n)) ) ); ! 975: putcomma(ncomma, TYINT, NO); ! 976: } ! 977: ! 978: ! 979: ! 980: ! 981: ! 982: LOCAL putct1(q, lp, cp, ip, ncommap) ! 983: register expptr q; ! 984: register Addrp lp, cp; ! 985: int *ip, *ncommap; ! 986: { ! 987: int i; ! 988: Addrp lp1, cp1; ! 989: ! 990: if(q->tag==TEXPR && q->exprblock.opcode==OPCONCAT) ! 991: { ! 992: putct1(q->exprblock.leftp, lp, cp, ip, ncommap); ! 993: putct1(q->exprblock.rightp, lp, cp , ip, ncommap); ! 994: frexpr(q->exprblock.vleng); ! 995: free( (charptr) q ); ! 996: } ! 997: else ! 998: { ! 999: i = (*ip)++; ! 1000: lp1 = (Addrp) cpexpr(lp); ! 1001: lp1->memoffset = mkexpr(OPPLUS,lp1->memoffset, ICON(i*SZLENG)); ! 1002: cp1 = (Addrp) cpexpr(cp); ! 1003: cp1->memoffset = mkexpr(OPPLUS, cp1->memoffset, ICON(i*SZADDR)); ! 1004: putassign( lp1, cpexpr(q->headblock.vleng) ); ! 1005: putassign( cp1, addrof(putch1(q,ncommap)) ); ! 1006: *ncommap += 2; ! 1007: } ! 1008: } ! 1009: ! 1010: LOCAL putaddr(p, indir) ! 1011: register Addrp p; ! 1012: int indir; ! 1013: { ! 1014: int type, type2, funct; ! 1015: ftnint offset, simoffset(); ! 1016: expptr offp, shorten(); ! 1017: ! 1018: if( p->tag==TERROR || (p->memoffset!=NULL && ISERROR(p->memoffset)) ) ! 1019: { ! 1020: frexpr(p); ! 1021: return; ! 1022: } ! 1023: ! 1024: type = p->vtype; ! 1025: type2 = types2[type]; ! 1026: funct = (p->vclass==CLPROC ? P2FUNCT<<2 : 0); ! 1027: ! 1028: offp = (p->memoffset ? (expptr) cpexpr(p->memoffset) : (expptr)NULL ); ! 1029: ! 1030: ! 1031: #if (FUDGEOFFSET != 1) ! 1032: if(offp) ! 1033: offp = mkexpr(OPSTAR, ICON(FUDGEOFFSET), offp); ! 1034: #endif ! 1035: ! 1036: offset = simoffset( &offp ); ! 1037: #if SZINT < SZLONG ! 1038: if(offp) ! 1039: if(shortsubs) ! 1040: offp = shorten(offp); ! 1041: else ! 1042: offp = mkconv(TYINT, offp); ! 1043: #else ! 1044: if(offp) ! 1045: offp = mkconv(TYINT, offp); ! 1046: #endif ! 1047: ! 1048: switch(p->vstg) ! 1049: { ! 1050: case STGAUTO: ! 1051: if(indir && !offp) ! 1052: { ! 1053: p2oreg(offset, AUTOREG, type2); ! 1054: break; ! 1055: } ! 1056: ! 1057: if(!indir && !offp && !offset) ! 1058: { ! 1059: p2reg(AUTOREG, type2 | P2PTR); ! 1060: break; ! 1061: } ! 1062: ! 1063: p2reg(AUTOREG, type2 | P2PTR); ! 1064: if(offp) ! 1065: { ! 1066: putx(offp); ! 1067: if(offset) ! 1068: p2icon(offset, P2INT); ! 1069: } ! 1070: else ! 1071: p2icon(offset, P2INT); ! 1072: if(offp && offset) ! 1073: p2op(P2PLUS, type2 | P2PTR); ! 1074: p2op(P2PLUS, type2 | P2PTR); ! 1075: if(indir) ! 1076: p2op(P2INDIRECT, type2); ! 1077: break; ! 1078: ! 1079: case STGARG: ! 1080: p2oreg( ! 1081: #ifdef ARGOFFSET ! 1082: ARGOFFSET + ! 1083: #endif ! 1084: (ftnint) (FUDGEOFFSET*p->memno), ! 1085: ARGREG, type2 | P2PTR | funct ); ! 1086: ! 1087: based: ! 1088: if(offp) ! 1089: putx(offp); ! 1090: if(offset) ! 1091: { ! 1092: p2icon(offset, P2INT); ! 1093: p2op(P2PLUS, type2 | P2PTR); ! 1094: } ! 1095: if(offp) ! 1096: p2op(P2PLUS, type2 | P2PTR); ! 1097: if(indir) ! 1098: p2op(P2INDIRECT, type2); ! 1099: break; ! 1100: ! 1101: case STGLENG: ! 1102: if(indir) ! 1103: { ! 1104: p2oreg( ! 1105: #ifdef ARGOFFSET ! 1106: ARGOFFSET + ! 1107: #endif ! 1108: (ftnint) (FUDGEOFFSET*p->memno), ! 1109: ARGREG, type2 ); ! 1110: } ! 1111: else { ! 1112: p2reg(ARGREG, type2 | P2PTR ); ! 1113: p2icon( ! 1114: #ifdef ARGOFFSET ! 1115: ARGOFFSET + ! 1116: #endif ! 1117: (ftnint) (FUDGEOFFSET*p->memno), P2INT); ! 1118: p2op(P2PLUS, type2 | P2PTR ); ! 1119: } ! 1120: break; ! 1121: ! 1122: ! 1123: case STGBSS: ! 1124: case STGINIT: ! 1125: case STGEXT: ! 1126: case STGCOMMON: ! 1127: case STGEQUIV: ! 1128: case STGCONST: ! 1129: if(offp) ! 1130: { ! 1131: putx(offp); ! 1132: putmem(p, P2ICON, offset); ! 1133: p2op(P2PLUS, type2 | P2PTR); ! 1134: if(indir) ! 1135: p2op(P2INDIRECT, type2); ! 1136: } ! 1137: else ! 1138: putmem(p, (indir ? P2NAME : P2ICON), offset); ! 1139: ! 1140: break; ! 1141: ! 1142: case STGREG: ! 1143: if(indir) ! 1144: p2reg(p->memno, type2); ! 1145: else ! 1146: fatal("attempt to take address of a register"); ! 1147: break; ! 1148: ! 1149: /* for possible future use -- register based arrays ! 1150: case STGPREG: ! 1151: if(indir && !offp) ! 1152: p2oreg(offset, p->memno, type2); ! 1153: else ! 1154: { ! 1155: p2reg(p->memno, type2 | P2PTR); ! 1156: goto based; ! 1157: } ! 1158: break; ! 1159: */ ! 1160: ! 1161: default: ! 1162: badstg("putaddr", p->vstg); ! 1163: } ! 1164: frexpr(p); ! 1165: } ! 1166: ! 1167: ! 1168: ! 1169: ! 1170: LOCAL putmem(p, class, offset) ! 1171: expptr p; ! 1172: int class; ! 1173: ftnint offset; ! 1174: { ! 1175: int type2; ! 1176: int funct; ! 1177: char *name, *memname(); ! 1178: ! 1179: funct = (p->headblock.vclass==CLPROC ? P2FUNCT<<2 : 0); ! 1180: type2 = types2[p->headblock.vtype]; ! 1181: if(p->headblock.vclass == CLPROC) ! 1182: type2 |= (P2FUNCT<<2); ! 1183: name = memname(p->addrblock.vstg, p->addrblock.memno); ! 1184: if(class == P2ICON) ! 1185: { ! 1186: p2triple(P2ICON, name[0]!='\0', type2|P2PTR); ! 1187: p2word(offset); ! 1188: if(name[0]) ! 1189: p2name(name); ! 1190: } ! 1191: else ! 1192: { ! 1193: p2triple(P2NAME, offset!=0, type2); ! 1194: if(offset != 0) ! 1195: p2word(offset); ! 1196: p2name(name); ! 1197: } ! 1198: } ! 1199: ! 1200: ! 1201: ! 1202: LOCAL Addrp putcall(p) ! 1203: register Exprp p; ! 1204: { ! 1205: chainp arglist, charsp, cp; ! 1206: int n, first; ! 1207: Addrp t; ! 1208: register expptr q; ! 1209: Addrp fval; ! 1210: int type, type2, ctype, qtype, indir; ! 1211: ! 1212: type2 = types2[type = p->vtype]; ! 1213: charsp = NULL; ! 1214: indir = (p->opcode == OPCCALL); ! 1215: n = 0; ! 1216: first = YES; ! 1217: ! 1218: if(p->rightp) ! 1219: { ! 1220: arglist = p->rightp->listblock.listp; ! 1221: free( (charptr) (p->rightp) ); ! 1222: } ! 1223: else ! 1224: arglist = NULL; ! 1225: ! 1226: for(cp = arglist ; cp ; cp = cp->nextp) ! 1227: if(indir) ! 1228: ++n; ! 1229: else { ! 1230: q = (expptr) (cp->datap); ! 1231: if( ISCONST(q) ) ! 1232: { ! 1233: q = (expptr) putconst(q); ! 1234: cp->datap = (tagptr) q; ! 1235: } ! 1236: if( ISCHAR(q) && q->headblock.vclass!=CLPROC ) ! 1237: { ! 1238: charsp = hookup(charsp, ! 1239: mkchain(cpexpr(q->headblock.vleng), ! 1240: CHNULL)); ! 1241: n += 2; ! 1242: } ! 1243: else ! 1244: n += 1; ! 1245: } ! 1246: ! 1247: if(type == TYCHAR) ! 1248: { ! 1249: if( ISICON(p->vleng) ) ! 1250: { ! 1251: fval = mktemp(TYCHAR, p->vleng); ! 1252: n += 2; ! 1253: } ! 1254: else { ! 1255: err("adjustable character function"); ! 1256: return; ! 1257: } ! 1258: } ! 1259: else if( ISCOMPLEX(type) ) ! 1260: { ! 1261: fval = mktemp(type, PNULL); ! 1262: n += 1; ! 1263: } ! 1264: else ! 1265: fval = NULL; ! 1266: ! 1267: ctype = (fval ? P2INT : type2); ! 1268: putaddr(p->leftp, NO); ! 1269: ! 1270: if(fval) ! 1271: { ! 1272: first = NO; ! 1273: putaddr( cpexpr(fval), NO); ! 1274: if(type==TYCHAR) ! 1275: { ! 1276: putx( mkconv(TYLENG,p->vleng) ); ! 1277: p2op(P2LISTOP, type2); ! 1278: } ! 1279: } ! 1280: ! 1281: for(cp = arglist ; cp ; cp = cp->nextp) ! 1282: { ! 1283: q = (expptr) (cp->datap); ! 1284: if(q->tag==TADDR && (indir || q->addrblock.vstg!=STGREG) ) ! 1285: putaddr(q, indir && q->addrblock.vtype!=TYCHAR); ! 1286: else if( ISCOMPLEX(q->headblock.vtype) ) ! 1287: putcxop(q); ! 1288: else if (ISCHAR(q) ) ! 1289: putchop(q); ! 1290: else if( ! ISERROR(q) ) ! 1291: { ! 1292: if(indir) ! 1293: putx(q); ! 1294: else { ! 1295: t = mktemp(qtype = q->headblock.vtype, ! 1296: q->headblock.vleng); ! 1297: putassign( cpexpr(t), q ); ! 1298: putaddr(t, NO); ! 1299: putcomma(1, qtype, YES); ! 1300: } ! 1301: } ! 1302: if(first) ! 1303: first = NO; ! 1304: else ! 1305: p2op(P2LISTOP, type2); ! 1306: } ! 1307: ! 1308: if(arglist) ! 1309: frchain(&arglist); ! 1310: for(cp = charsp ; cp ; cp = cp->nextp) ! 1311: { ! 1312: putx( mkconv(TYLENG,cp->datap) ); ! 1313: p2op(P2LISTOP, type2); ! 1314: } ! 1315: frchain(&charsp); ! 1316: p2op(n>0 ? P2CALL : P2CALL0 , ctype); ! 1317: free( (charptr) p ); ! 1318: return(fval); ! 1319: } ! 1320: ! 1321: ! 1322: ! 1323: LOCAL putmnmx(p) ! 1324: register expptr p; ! 1325: { ! 1326: int op, type; ! 1327: int ncomma; ! 1328: expptr qp; ! 1329: chainp p0, p1; ! 1330: Addrp sp, tp; ! 1331: ! 1332: if(p->tag != TEXPR) ! 1333: badtag("putmnmx", p->tag); ! 1334: ! 1335: type = p->exprblock.vtype; ! 1336: op = (p->exprblock.opcode==OPMIN ? OPLT : OPGT ); ! 1337: p0 = p->exprblock.leftp->listblock.listp; ! 1338: free( (charptr) (p->exprblock.leftp) ); ! 1339: free( (charptr) p ); ! 1340: ! 1341: sp = mktemp(type, PNULL); ! 1342: tp = mktemp(type, PNULL); ! 1343: qp = mkexpr(OPCOLON, cpexpr(tp), cpexpr(sp)); ! 1344: qp = mkexpr(OPQUEST, mkexpr(op, cpexpr(tp),cpexpr(sp)), qp); ! 1345: qp = fixexpr(qp); ! 1346: ! 1347: ncomma = 1; ! 1348: putassign( cpexpr(sp), p0->datap ); ! 1349: ! 1350: for(p1 = p0->nextp ; p1 ; p1 = p1->nextp) ! 1351: { ! 1352: ++ncomma; ! 1353: putassign( cpexpr(tp), p1->datap ); ! 1354: if(p1->nextp) ! 1355: { ! 1356: ++ncomma; ! 1357: putassign( cpexpr(sp), cpexpr(qp) ); ! 1358: } ! 1359: else ! 1360: putx(qp); ! 1361: } ! 1362: ! 1363: putcomma(ncomma, type, NO); ! 1364: frtemp(sp); ! 1365: frtemp(tp); ! 1366: frchain( &p0 ); ! 1367: } ! 1368: ! 1369: ! 1370: ! 1371: ! 1372: LOCAL putcomma(n, type, indir) ! 1373: int n, type, indir; ! 1374: { ! 1375: type = types2[type]; ! 1376: if(indir) ! 1377: type |= P2PTR; ! 1378: while(--n >= 0) ! 1379: p2op(P2COMOP, type); ! 1380: } ! 1381: ! 1382: ! 1383: ! 1384: ! 1385: ftnint simoffset(p0) ! 1386: expptr *p0; ! 1387: { ! 1388: ftnint offset, prod; ! 1389: register expptr p, lp, rp; ! 1390: ! 1391: offset = 0; ! 1392: p = *p0; ! 1393: if(p == NULL) ! 1394: return(0); ! 1395: ! 1396: if( ! ISINT(p->headblock.vtype) ) ! 1397: return(0); ! 1398: ! 1399: if(p->tag==TEXPR && p->exprblock.opcode==OPSTAR) ! 1400: { ! 1401: lp = p->exprblock.leftp; ! 1402: rp = p->exprblock.rightp; ! 1403: if(ISICON(rp) && lp->tag==TEXPR && ! 1404: lp->exprblock.opcode==OPPLUS && ISICON(lp->exprblock.rightp)) ! 1405: { ! 1406: p->exprblock.opcode = OPPLUS; ! 1407: lp->exprblock.opcode = OPSTAR; ! 1408: prod = rp->constblock.const.ci * ! 1409: lp->exprblock.rightp->constblock.const.ci; ! 1410: lp->exprblock.rightp->constblock.const.ci = rp->constblock.const.ci; ! 1411: rp->constblock.const.ci = prod; ! 1412: } ! 1413: } ! 1414: ! 1415: if(p->tag==TEXPR && p->exprblock.opcode==OPPLUS && ! 1416: ISICON(p->exprblock.rightp)) ! 1417: { ! 1418: rp = p->exprblock.rightp; ! 1419: lp = p->exprblock.leftp; ! 1420: offset += rp->constblock.const.ci; ! 1421: frexpr(rp); ! 1422: free( (charptr) p ); ! 1423: *p0 = lp; ! 1424: } ! 1425: ! 1426: if( ISCONST(p) ) ! 1427: { ! 1428: offset += p->constblock.const.ci; ! 1429: frexpr(p); ! 1430: *p0 = NULL; ! 1431: } ! 1432: ! 1433: return(offset); ! 1434: } ! 1435: ! 1436: ! 1437: ! 1438: ! 1439: ! 1440: p2op(op, type) ! 1441: int op, type; ! 1442: { ! 1443: p2triple(op, 0, type); ! 1444: } ! 1445: ! 1446: p2icon(offset, type) ! 1447: ftnint offset; ! 1448: int type; ! 1449: { ! 1450: p2triple(P2ICON, 0, type); ! 1451: p2word(offset); ! 1452: } ! 1453: ! 1454: ! 1455: ! 1456: ! 1457: p2oreg(offset, reg, type) ! 1458: ftnint offset; ! 1459: int reg, type; ! 1460: { ! 1461: p2triple(P2OREG, reg, type); ! 1462: p2word(offset); ! 1463: p2name(""); ! 1464: } ! 1465: ! 1466: ! 1467: ! 1468: ! 1469: p2reg(reg, type) ! 1470: int reg, type; ! 1471: { ! 1472: p2triple(P2REG, reg, type); ! 1473: } ! 1474: ! 1475: ! 1476: ! 1477: p2pi(s, i) ! 1478: char *s; ! 1479: int i; ! 1480: { ! 1481: char buff[100]; ! 1482: sprintf(buff, s, i); ! 1483: p2pass(buff); ! 1484: } ! 1485: ! 1486: ! 1487: ! 1488: p2pij(s, i, j) ! 1489: char *s; ! 1490: int i, j; ! 1491: { ! 1492: char buff[100]; ! 1493: sprintf(buff, s, i, j); ! 1494: p2pass(buff); ! 1495: } ! 1496: ! 1497: ! 1498: ! 1499: ! 1500: p2ps(s, t) ! 1501: char *s, *t; ! 1502: { ! 1503: char buff[100]; ! 1504: sprintf(buff, s, t); ! 1505: p2pass(buff); ! 1506: } ! 1507: ! 1508: ! 1509: ! 1510: ! 1511: p2pass(s) ! 1512: char *s; ! 1513: { ! 1514: p2triple(P2PASS, (strlen(s) + FOUR-1)/FOUR, 0); ! 1515: p2str(s); ! 1516: } ! 1517: ! 1518: ! 1519: ! 1520: ! 1521: p2str(s) ! 1522: register char *s; ! 1523: { ! 1524: union { long int word; char str[FOUR]; } u; ! 1525: register int i; ! 1526: ! 1527: i = 0; ! 1528: u.word = 0; ! 1529: while(*s) ! 1530: { ! 1531: u.str[i++] = *s++; ! 1532: if(i == FOUR) ! 1533: { ! 1534: p2word(u.word); ! 1535: u.word = 0; ! 1536: i = 0; ! 1537: } ! 1538: } ! 1539: if(i > 0) ! 1540: p2word(u.word); ! 1541: } ! 1542: ! 1543: ! 1544: ! 1545: ! 1546: p2triple(op, var, type) ! 1547: int op, var, type; ! 1548: { ! 1549: register long word; ! 1550: word = op | (var<<8); ! 1551: word |= ( (long int) type) <<16; ! 1552: p2word(word); ! 1553: } ! 1554: ! 1555: ! 1556: ! 1557: ! 1558: ! 1559: p2name(s) ! 1560: register char *s; ! 1561: { ! 1562: register int i; ! 1563: ! 1564: #ifdef UCBPASS2 ! 1565: /* arbitrary length names, terminated by a null, ! 1566: padded to a full word */ ! 1567: ! 1568: # define WL sizeof(long int) ! 1569: union { long int word; char str[WL]; } w; ! 1570: ! 1571: w.word = 0; ! 1572: i = 0; ! 1573: while(w.str[i++] = *s++) ! 1574: if(i == WL) ! 1575: { ! 1576: p2word(w.word); ! 1577: w.word = 0; ! 1578: i = 0; ! 1579: } ! 1580: if(i > 0) ! 1581: p2word(w.word); ! 1582: #else ! 1583: /* standard intermediate, names are 8 characters long */ ! 1584: ! 1585: union { long int word[2]; char str[8]; } u; ! 1586: ! 1587: u.word[0] = u.word[1] = 0; ! 1588: for(i = 0 ; i<8 && *s ; ++i) ! 1589: u.str[i] = *s++; ! 1590: p2word(u.word[0]); ! 1591: p2word(u.word[1]); ! 1592: ! 1593: #endif ! 1594: ! 1595: } ! 1596: ! 1597: ! 1598: ! 1599: ! 1600: p2word(w) ! 1601: long int w; ! 1602: { ! 1603: *p2bufp++ = w; ! 1604: if(p2bufp >= p2bufend) ! 1605: p2flush(); ! 1606: } ! 1607: ! 1608: ! 1609: ! 1610: p2flush() ! 1611: { ! 1612: if(p2bufp > p2buff) ! 1613: write(fileno(textfile), p2buff, (p2bufp-p2buff)*sizeof(long int)); ! 1614: p2bufp = p2buff; ! 1615: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.