Return to putpcc.c CVS log

Up to [Power 6/32 Unix Tahoe 4.2BSD] / cci / usr / src / usr.bin / f77 / f77pass1

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

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

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