4.3BSD - /usr/src/usr.bin/f77/src/f77pass1/put.c

   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[] = "@(#)put.c	5.1 (Berkeley) 6/7/85";
   9: #endif not lint
  10: 
  11: /*
  12:  * put.c
  13:  *
  14:  * Intermediate code generation procedures common to both
  15:  * Johnson (Portable) and Ritchie families of second passes
  16:  *
  17:  * University of Utah CS Dept modification history:
  18:  *
  19:  * $Log:	put.c,v $
  20:  * Revision 3.2  85/05/04  15:41:24  mckusick
  21:  * Fix alignment problem -- change code to match comment...
  22:  *
  23:  * Revision 3.2  85/04/29  21:36:07  donn
  24:  * Fix alignment problem -- change code to match comment...
  25:  *
  26:  * Revision 3.1  85/02/27  19:12:04  donn
  27:  * Changed to use pcc.h instead of pccdefs.h.
  28:  *
  29:  * Revision 2.1  84/07/19  12:04:21  donn
  30:  * Changed comment headers for UofU.
  31:  *
  32:  * Revision 1.2  84/04/02  14:40:21  donn
  33:  * Added fixes from Conrad Huang at UCSF for calculating the length of a
  34:  * concatenation of strings correctly.
  35:  *
  36:  */
  37: 
  38: #include "defs.h"
  39: 
  40: #if FAMILY == PCC
  41: #	include <pcc.h>
  42: #else
  43: #	include "dmrdefs.h"
  44: #endif
  45: 
  46: /*
  47: char *ops [ ] =
  48: 	{
  49: 	"??", "+", "-", "*", "/", "**", "-",
  50: 	"OR", "AND", "EQV", "NEQV", "NOT",
  51: 	"CONCAT",
  52: 	"<", "==", ">", "<=", "!=", ">=",
  53: 	" of ", " ofC ", " = ", " += ", " *= ", " CONV ", " << ", " % ",
  54: 	" , ", " ? ", " : "
  55: 	" abs ", " min ", " max ", " addr ", " indirect ",
  56: 	" bitor ", " bitand ", " bitxor ", " bitnot ", " >> ", " () "
  57: 	};
  58: */
  59: 
  60: int ops2 [ ] =
  61:     {
  62:     PCC_ERROR, PCC_PLUS, PCC_MINUS, PCC_MUL, PCC_DIV, PCC_ERROR, PCC_UMINUS,
  63:     PCC_OROR, PCC_ANDAND, PCC_EQ, PCC_NE, PCC_NOT,
  64:     PCC_ERROR,
  65:     PCC_LT, PCC_EQ, PCC_GT, PCC_LE, PCC_NE, PCC_GE,
  66:     PCC_CALL, PCC_CALL, PCC_ASSIGN, PCC_PLUSEQ, PCC_MULEQ, PCC_SCONV, PCC_LS, PCC_MOD,
  67:     PCC_COMOP, PCC_QUEST, PCC_COLON,
  68:     PCC_ERROR, PCC_ERROR, PCC_ERROR, PCC_ERROR, PCC_DEREF,
  69:     PCC_OR, PCC_AND, PCC_ER, PCC_COMPL, PCC_RS, PCC_ERROR
  70:     };
  71: 
  72: 
  73: int types2 [ ] =
  74:     {
  75:     PCC_ERROR, PCCT_INT|PCCTM_PTR, PCCT_SHORT, PCCT_LONG, PCCT_FLOAT, PCCT_DOUBLE,
  76: #if TARGET == INTERDATA
  77:     PCC_ERROR, PCC_ERROR, PCCT_LONG, PCCT_CHAR, PCCT_INT, PCC_ERROR
  78: #else
  79:     PCCT_FLOAT, PCCT_DOUBLE, PCCT_LONG, PCCT_CHAR, PCCT_INT, PCC_ERROR
  80: #endif
  81:     };
  82: 
  83: 
  84: setlog()
  85: {
  86: types2[TYLOGICAL] = types2[tylogical];
  87: typesize[TYLOGICAL] = typesize[tylogical];
  88: typealign[TYLOGICAL] = typealign[tylogical];
  89: }
  90: 
  91: 
  92: putex1(p)
  93: expptr p;
  94: {
  95: putx( fixtype(p) );
  96: 
  97: if (!optimflag)
  98:     {
  99:     templist = hookup(templist, holdtemps);
 100:     holdtemps = NULL;
 101:     }
 102: }
 103: 
 104: 
 105: 
 106: 
 107: 
 108: putassign(lp, rp)
 109: expptr lp, rp;
 110: {
 111: putx( fixexpr( mkexpr(OPASSIGN, lp, rp) ));
 112: }
 113: 
 114: 
 115: 
 116: 
 117: puteq(lp, rp)
 118: expptr lp, rp;
 119: {
 120: putexpr( mkexpr(OPASSIGN, lp, rp) );
 121: }
 122: 
 123: 
 124: 
 125: 
 126: /* put code for  a *= b */
 127: 
 128: putsteq(a, b)
 129: expptr a, b;
 130: {
 131: putx( fixexpr( mkexpr(OPSTAREQ, cpexpr(a), cpexpr(b)) ));
 132: }
 133: 
 134: 
 135: 
 136: 
 137: 
 138: Addrp realpart(p)
 139: register Addrp p;
 140: {
 141: register Addrp q;
 142: 
 143: q = (Addrp) cpexpr(p);
 144: if( ISCOMPLEX(p->vtype) )
 145:     q->vtype += (TYREAL-TYCOMPLEX);
 146: return(q);
 147: }
 148: 
 149: 
 150: 
 151: 
 152: expptr imagpart(p)
 153: register expptr p;
 154: {
 155: register Addrp q;
 156: expptr mkrealcon();
 157: 
 158: if (ISCONST(p))
 159:     {
 160:     if (ISCOMPLEX(p->constblock.vtype))
 161:         return(mkrealcon(p->constblock.vtype == TYCOMPLEX ?
 162:                     TYREAL : TYDREAL,
 163:                 p->constblock.const.cd[1]));
 164:     else if (p->constblock.vtype == TYDREAL)
 165:         return(mkrealcon(TYDREAL, 0.0));
 166:     else
 167:         return(mkrealcon(TYREAL, 0.0));
 168:     }
 169: else if (p->tag == TADDR)
 170:     {
 171:     if( ISCOMPLEX(p->addrblock.vtype) )
 172:         {
 173:         q = (Addrp) cpexpr(p);
 174:         q->vtype += (TYREAL-TYCOMPLEX);
 175:         q->memoffset = mkexpr(OPPLUS, q->memoffset,
 176:                     ICON(typesize[q->vtype]));
 177:         return( (expptr) q );
 178:         }
 179:     else
 180:         return( mkrealcon( ISINT(p->addrblock.vtype) ?
 181:             TYDREAL : p->addrblock.vtype , 0.0));
 182:     }
 183: else
 184:     badtag("imagpart", p->tag);
 185: }
 186: 
 187: 
 188: 
 189: 
 190: ncat(p)
 191: register expptr p;
 192: {
 193: if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
 194:     return( ncat(p->exprblock.leftp) + ncat(p->exprblock.rightp) );
 195: else    return(1);
 196: }
 197: 
 198: 
 199: 
 200: 
 201: ftnint lencat(p)
 202: register expptr p;
 203: {
 204: if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
 205:     return( lencat(p->exprblock.leftp) + lencat(p->exprblock.rightp) );
 206: else if( p->headblock.vleng!=NULL && ISICON(p->headblock.vleng) )
 207:     return(p->headblock.vleng->constblock.const.ci);
 208: else if(p->tag==TADDR && p->addrblock.varleng!=0)
 209:     return(p->addrblock.varleng);
 210: else if(p->tag==TTEMP && p->tempblock.varleng!=0)
 211:     return(p->tempblock.varleng);
 212: else
 213:     {
 214:     err("impossible element in concatenation");
 215:     return(0);
 216:     }
 217: }
 218: 
 219: Addrp putconst(p)
 220: register Constp p;
 221: {
 222: register Addrp q;
 223: struct Literal *litp, *lastlit;
 224: int i, k, type;
 225: int litflavor;
 226: 
 227: if( p->tag != TCONST )
 228:     badtag("putconst", p->tag);
 229: 
 230: q = ALLOC(Addrblock);
 231: q->tag = TADDR;
 232: type = p->vtype;
 233: q->vtype = ( type==TYADDR ? TYINT : type );
 234: q->vleng = (expptr) cpexpr(p->vleng);
 235: q->vstg = STGCONST;
 236: q->memno = newlabel();
 237: q->memoffset = ICON(0);
 238: 
 239: /* check for value in literal pool, and update pool if necessary */
 240: 
 241: switch(type = p->vtype)
 242:     {
 243:     case TYCHAR:
 244:         if(p->vleng->constblock.const.ci > XL)
 245:             break;  /* too long for literal table */
 246:         litflavor = 1;
 247:         goto loop;
 248: 
 249:     case TYREAL:
 250:     case TYDREAL:
 251:         litflavor = 2;
 252:         goto loop;
 253: 
 254:     case TYLOGICAL:
 255:         type = tylogical;
 256:     case TYSHORT:
 257:     case TYLONG:
 258:         litflavor = 3;
 259: 
 260:     loop:
 261:         lastlit = litpool + nliterals;
 262:         for(litp = litpool ; litp<lastlit ; ++litp)
 263:             if(type == litp->littype) switch(litflavor)
 264:                 {
 265:             case 1:
 266:                 if(p->vleng->constblock.const.ci != litp->litval.litcval.litclen)
 267:                     break;
 268:                 if(! eqn( (int) p->vleng->constblock.const.ci, p->const.ccp,
 269:                     litp->litval.litcval.litcstr) )
 270:                         break;
 271: 
 272:             ret:
 273:                 q->memno = litp->litnum;
 274:                 frexpr(p);
 275:                 return(q);
 276: 
 277:             case 2:
 278:                 if(p->const.cd[0] == litp->litval.litdval)
 279:                     goto ret;
 280:                 break;
 281: 
 282:             case 3:
 283:                 if(p->const.ci == litp->litval.litival)
 284:                     goto ret;
 285:                 break;
 286:                 }
 287:         if(nliterals < MAXLITERALS)
 288:             {
 289:             ++nliterals;
 290:             litp->littype = type;
 291:             litp->litnum = q->memno;
 292:             switch(litflavor)
 293:                 {
 294:                 case 1:
 295:                     litp->litval.litcval.litclen =
 296:                         p->vleng->constblock.const.ci;
 297:                     cpn( (int) litp->litval.litcval.litclen,
 298:                         p->const.ccp,
 299:                         litp->litval.litcval.litcstr);
 300:                     break;
 301: 
 302:                 case 2:
 303:                     litp->litval.litdval = p->const.cd[0];
 304:                     break;
 305: 
 306:                 case 3:
 307:                     litp->litval.litival = p->const.ci;
 308:                     break;
 309:                 }
 310:             }
 311:     default:
 312:         break;
 313:     }
 314: 
 315: preven(typealign[ type==TYCHAR ? TYLONG : type ]);
 316: prlabel(asmfile, q->memno);
 317: 
 318: k = 1;
 319: switch(type)
 320:     {
 321:     case TYLOGICAL:
 322:     case TYSHORT:
 323:     case TYLONG:
 324:         prconi(asmfile, type, p->const.ci);
 325:         break;
 326: 
 327:     case TYCOMPLEX:
 328:         k = 2;
 329:     case TYREAL:
 330:         type = TYREAL;
 331:         goto flpt;
 332: 
 333:     case TYDCOMPLEX:
 334:         k = 2;
 335:     case TYDREAL:
 336:         type = TYDREAL;
 337: 
 338:     flpt:
 339:         for(i = 0 ; i < k ; ++i)
 340:             prconr(asmfile, type, p->const.cd[i]);
 341:         break;
 342: 
 343:     case TYCHAR:
 344:         putstr(asmfile, p->const.ccp,
 345:             (int) (p->vleng->constblock.const.ci) );
 346:         break;
 347: 
 348:     case TYADDR:
 349:         prcona(asmfile, p->const.ci);
 350:         break;
 351: 
 352:     default:
 353:         badtype("putconst", p->vtype);
 354:     }
 355: 
 356: frexpr(p);
 357: return( q );
 358: }
 359: 
 360: /*
 361:  * put out a character string constant.  begin every one on
 362:  * a long integer boundary, and pad with nulls
 363:  */
 364: putstr(fp, s, n)
 365: FILEP fp;
 366: register char *s;
 367: register int n;
 368: {
 369: int b[SZLONG];
 370: register int i;
 371: 
 372: i = 0;
 373: while(--n >= 0)
 374:     {
 375:     b[i++] = *s++;
 376:     if(i == SZLONG)
 377:         {
 378:         prchars(fp, b);
 379:         prchars(fp, b+SZSHORT);
 380:         i = 0;
 381:         }
 382:     }
 383: 
 384: while(i < SZLONG)
 385:     b[i++] = '\0';
 386: prchars(fp, b);
 387: prchars(fp, b+SZSHORT);
 388: }

Defined functions

Defined variables