Return to putpcc.c CVS log

Up to [CSRG BSD Unix] / 43BSDReno / pgrm / f77 / pass1.tahoe

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

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