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