Return to putscj.c CVS log

Up to [Research Unix] / researchv10no / cmd / f77 / alt

Annotation of researchv10no/cmd/f77/alt/putscj.c, revision 1.1

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

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.