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