Annotation of 40BSD/cmd/f77/put.c, revision 1.1.1.1

1.1       root        1: /*
                      2:  * INTERMEDIATE CODE GENERATION PROCEDURES COMMON TO BOTH
                      3:  * JOHNSON (PORTABLE) AND RITCHIE FAMILIES OF SECOND PASSES
                      4: */
                      5: 
                      6: #include "defs"
                      7: 
                      8: #if FAMILY == PCC
                      9: #      include "pccdefs"
                     10: #else
                     11: #      include "dmrdefs"
                     12: #endif
                     13: 
                     14: /*
                     15: char *ops [ ] =
                     16:        {
                     17:        "??", "+", "-", "*", "/", "**", "-",
                     18:        "OR", "AND", "EQV", "NEQV", "NOT",
                     19:        "CONCAT",
                     20:        "<", "==", ">", "<=", "!=", ">=",
                     21:        " of ", " ofC ", " = ", " += ", " *= ", " CONV ", " << ", " % ",
                     22:        " , ", " ? ", " : "
                     23:        " abs ", " min ", " max ", " addr ", " indirect ",
                     24:        " bitor ", " bitand ", " bitxor ", " bitnot ", " >> ",
                     25:        };
                     26: */
                     27: 
                     28: int ops2 [ ] =
                     29:        {
                     30:        P2BAD, P2PLUS, P2MINUS, P2STAR, P2SLASH, P2BAD, P2NEG,
                     31:        P2OROR, P2ANDAND, P2EQ, P2NE, P2NOT,
                     32:        P2BAD,
                     33:        P2LT, P2EQ, P2GT, P2LE, P2NE, P2GE,
                     34:        P2CALL, P2CALL, P2ASSIGN, P2PLUSEQ, P2STAREQ, P2CONV, P2LSHIFT, P2MOD,
                     35:        P2COMOP, P2QUEST, P2COLON,
                     36:        P2BAD, P2BAD, P2BAD, P2BAD, P2BAD,
                     37:        P2BITOR, P2BITAND, P2BITXOR, P2BITNOT, P2RSHIFT
                     38:        };
                     39: 
                     40: 
                     41: int types2 [ ] =
                     42:        {
                     43:        P2BAD, P2INT|P2PTR, P2SHORT, P2LONG, P2REAL, P2DREAL,
                     44: #if TARGET == INTERDATA
                     45:        P2BAD, P2BAD, P2LONG, P2CHAR, P2INT, P2BAD
                     46: #else
                     47:        P2REAL, P2DREAL, P2LONG, P2CHAR, P2INT, P2BAD
                     48: #endif
                     49:        };
                     50: 
                     51: 
                     52: setlog()
                     53: {
                     54: types2[TYLOGICAL] = types2[tylogical];
                     55: typesize[TYLOGICAL] = typesize[tylogical];
                     56: typealign[TYLOGICAL] = typealign[tylogical];
                     57: }
                     58: 
                     59: 
                     60: putex1(p)
                     61: expptr p;
                     62: {
                     63: putx( fixtype(p) );
                     64: templist = hookup(templist, holdtemps);
                     65: holdtemps = NULL;
                     66: }
                     67: 
                     68: 
                     69: 
                     70: 
                     71: 
                     72: putassign(lp, rp)
                     73: expptr lp, rp;
                     74: {
                     75: putx( fixexpr( mkexpr(OPASSIGN, lp, rp) ));
                     76: }
                     77: 
                     78: 
                     79: 
                     80: 
                     81: puteq(lp, rp)
                     82: expptr lp, rp;
                     83: {
                     84: putexpr( mkexpr(OPASSIGN, lp, rp) );
                     85: }
                     86: 
                     87: 
                     88: 
                     89: 
                     90: /* put code for  a *= b */
                     91: 
                     92: putsteq(a, b)
                     93: expptr a, b;
                     94: {
                     95: putx( fixexpr( mkexpr(OPSTAREQ, cpexpr(a), cpexpr(b)) ));
                     96: }
                     97: 
                     98: 
                     99: 
                    100: 
                    101: 
                    102: Addrp realpart(p)
                    103: register Addrp p;
                    104: {
                    105: register Addrp q;
                    106: 
                    107: q = (Addrp) cpexpr(p);
                    108: if( ISCOMPLEX(p->vtype) )
                    109:        q->vtype += (TYREAL-TYCOMPLEX);
                    110: return(q);
                    111: }
                    112: 
                    113: 
                    114: 
                    115: 
                    116: expptr imagpart(p)
                    117: register Addrp p;
                    118: {
                    119: register Addrp q;
                    120: expptr mkrealcon();
                    121: 
                    122: if( ISCOMPLEX(p->vtype) )
                    123:        {
                    124:        q = (Addrp) cpexpr(p);
                    125:        q->vtype += (TYREAL-TYCOMPLEX);
                    126:        q->memoffset = mkexpr(OPPLUS, q->memoffset, ICON(typesize[q->vtype]));
                    127:        return( (expptr) q );
                    128:        }
                    129: else
                    130:        return( mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , 0.0));
                    131: }
                    132: 
                    133: 
                    134: 
                    135: 
                    136: 
                    137: ncat(p)
                    138: register expptr p;
                    139: {
                    140: if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
                    141:        return( ncat(p->exprblock.leftp) + ncat(p->exprblock.rightp) );
                    142: else   return(1);
                    143: }
                    144: 
                    145: 
                    146: 
                    147: 
                    148: ftnint lencat(p)
                    149: register expptr p;
                    150: {
                    151: if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
                    152:        return( lencat(p->exprblock.leftp) + lencat(p->exprblock.rightp) );
                    153: else if( p->headblock.vleng!=NULL && ISICON(p->headblock.vleng) )
                    154:        return(p->headblock.vleng->constblock.const.ci);
                    155: else if(p->tag==TADDR && p->addrblock.varleng!=0)
                    156:        return(p->addrblock.varleng);
                    157: else
                    158:        {
                    159:        err("impossible element in concatenation");
                    160:        return(0);
                    161:        }
                    162: }
                    163: 
                    164: Addrp putconst(p)
                    165: register Constp p;
                    166: {
                    167: register Addrp q;
                    168: struct Literal *litp, *lastlit;
                    169: int i, k, type;
                    170: int litflavor;
                    171: 
                    172: if( p->tag != TCONST )
                    173:        badtag("putconst", p->tag);
                    174: 
                    175: q = ALLOC(Addrblock);
                    176: q->tag = TADDR;
                    177: type = p->vtype;
                    178: q->vtype = ( type==TYADDR ? TYINT : type );
                    179: q->vleng = (expptr) cpexpr(p->vleng);
                    180: q->vstg = STGCONST;
                    181: q->memno = newlabel();
                    182: q->memoffset = ICON(0);
                    183: 
                    184: /* check for value in literal pool, and update pool if necessary */
                    185: 
                    186: switch(type = p->vtype)
                    187:        {
                    188:        case TYCHAR:
                    189:                if(p->vleng->constblock.const.ci > XL)
                    190:                        break;  /* too long for literal table */
                    191:                litflavor = 1;
                    192:                goto loop;
                    193: 
                    194:        case TYREAL:
                    195:        case TYDREAL:
                    196:                litflavor = 2;
                    197:                goto loop;
                    198: 
                    199:        case TYLOGICAL:
                    200:                type = tylogical;
                    201:        case TYSHORT:
                    202:        case TYLONG:
                    203:                litflavor = 3;
                    204: 
                    205:        loop:
                    206:                lastlit = litpool + nliterals;
                    207:                for(litp = litpool ; litp<lastlit ; ++litp)
                    208:                        if(type == litp->littype) switch(litflavor)
                    209:                                {
                    210:                        case 1:
                    211:                                if(p->vleng->constblock.const.ci != litp->litval.litcval.litclen)
                    212:                                        break;
                    213:                                if(! eqn( (int) p->vleng->constblock.const.ci, p->const.ccp,
                    214:                                        litp->litval.litcval.litcstr) )
                    215:                                                break;
                    216: 
                    217:                        ret:
                    218:                                q->memno = litp->litnum;
                    219:                                frexpr(p);
                    220:                                return(q);
                    221: 
                    222:                        case 2:
                    223:                                if(p->const.cd[0] == litp->litval.litdval)
                    224:                                        goto ret;
                    225:                                break;
                    226: 
                    227:                        case 3:
                    228:                                if(p->const.ci == litp->litval.litival)
                    229:                                        goto ret;
                    230:                                break;
                    231:                                }
                    232:                if(nliterals < MAXLITERALS)
                    233:                        {
                    234:                        ++nliterals;
                    235:                        litp->littype = type;
                    236:                        litp->litnum = q->memno;
                    237:                        switch(litflavor)
                    238:                                {
                    239:                                case 1:
                    240:                                        litp->litval.litcval.litclen =
                    241:                                                p->vleng->constblock.const.ci;
                    242:                                        cpn( (int) litp->litval.litcval.litclen,
                    243:                                                p->const.ccp,
                    244:                                                litp->litval.litcval.litcstr);
                    245:                                        break;
                    246: 
                    247:                                case 2:
                    248:                                        litp->litval.litdval = p->const.cd[0];
                    249:                                        break;
                    250: 
                    251:                                case 3:
                    252:                                        litp->litval.litival = p->const.ci;
                    253:                                        break;
                    254:                                }
                    255:                        }
                    256:        default:
                    257:                break;
                    258:        }
                    259: 
                    260: preven(typealign[ type==TYCHAR ? TYLONG : type ]);
                    261: prlabel(asmfile, q->memno);
                    262: 
                    263: k = 1;
                    264: switch(type)
                    265:        {
                    266:        case TYLOGICAL:
                    267:        case TYSHORT:
                    268:        case TYLONG:
                    269:                prconi(asmfile, type, p->const.ci);
                    270:                break;
                    271: 
                    272:        case TYCOMPLEX:
                    273:                k = 2;
                    274:        case TYREAL:
                    275:                type = TYREAL;
                    276:                goto flpt;
                    277: 
                    278:        case TYDCOMPLEX:
                    279:                k = 2;
                    280:        case TYDREAL:
                    281:                type = TYDREAL;
                    282: 
                    283:        flpt:
                    284:                for(i = 0 ; i < k ; ++i)
                    285:                        prconr(asmfile, type, p->const.cd[i]);
                    286:                break;
                    287: 
                    288:        case TYCHAR:
                    289:                putstr(asmfile, p->const.ccp,
                    290:                        (int) (p->vleng->constblock.const.ci) );
                    291:                break;
                    292: 
                    293:        case TYADDR:
                    294:                prcona(asmfile, p->const.ci);
                    295:                break;
                    296: 
                    297:        default:
                    298:                badtype("putconst", p->vtype);
                    299:        }
                    300: 
                    301: frexpr(p);
                    302: return( q );
                    303: }
                    304: 
                    305: /*
                    306:  * put out a character string constant.  begin every one on
                    307:  * a long integer boundary, and pad with nulls
                    308:  */
                    309: putstr(fp, s, n)
                    310: FILEP fp;
                    311: char *s;
                    312: int n;
                    313: {
                    314: int b[SZSHORT];
                    315: int i;
                    316: 
                    317: i = 0;
                    318: while(--n >= 0)
                    319:        {
                    320:        b[i++] = *s++;
                    321:        if(i == SZSHORT)
                    322:                {
                    323:                prchars(fp, b);
                    324:                i = 0;
                    325:                }
                    326:        }
                    327: 
                    328: while(i < SZSHORT)
                    329:        b[i++] = '\0';
                    330: prchars(fp, b);
                    331: }

unix.superglobalmegacorp.com

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