Return to putpcc.c CVS log

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

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

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