Return to putpcc.c CVS log

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

Annotation of 43BSD/usr.bin/f77/src/f77pass1/putpcc.c, revision 1.1

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

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