Return to putpcc.c CVS log

Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1

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

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