UNIX 7th Ed. - /usr/src/cmd/f77/put.c

   1: /*
   2:  * INTERMEDIATE CODE GENERATION PROCEDURES COMMON TO BOTH
   3:  * JOHNSON AND RITCHIE FAMILIES OF SECOND PASSES
   4: */
   5: 
   6: #include "defs"
   7: 
   8: #if FAMILY == SCJ
   9: #	include "scjdefs"
  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: }
  56: 
  57: 
  58: putex1(p)
  59: expptr p;
  60: {
  61: putx( fixtype(p) );
  62: templist = hookup(templist, holdtemps);
  63: holdtemps = NULL;
  64: }
  65: 
  66: 
  67: 
  68: 
  69: 
  70: putassign(lp, rp)
  71: expptr lp, rp;
  72: {
  73: putx( fixexpr( mkexpr(OPASSIGN, lp, rp) ));
  74: }
  75: 
  76: 
  77: 
  78: 
  79: puteq(lp, rp)
  80: expptr lp, rp;
  81: {
  82: putexpr( mkexpr(OPASSIGN, lp, rp) );
  83: }
  84: 
  85: 
  86: 
  87: 
  88: /* put code for  a *= b */
  89: 
  90: putsteq(a, b)
  91: expptr a, b;
  92: {
  93: putx( fixexpr( mkexpr(OPSTAREQ, cpexpr(a), cpexpr(b)) ));
  94: }
  95: 
  96: 
  97: 
  98: 
  99: 
 100: struct addrblock *realpart(p)
 101: register struct addrblock *p;
 102: {
 103: register struct addrblock *q;
 104: 
 105: q = cpexpr(p);
 106: if( ISCOMPLEX(p->vtype) )
 107:     q->vtype += (TYREAL-TYCOMPLEX);
 108: return(q);
 109: }
 110: 
 111: 
 112: 
 113: 
 114: struct addrblock *imagpart(p)
 115: register struct addrblock *p;
 116: {
 117: register struct addrblock *q;
 118: struct constblock *mkrealcon();
 119: 
 120: if( ISCOMPLEX(p->vtype) )
 121:     {
 122:     q = cpexpr(p);
 123:     q->vtype += (TYREAL-TYCOMPLEX);
 124:     q->memoffset = mkexpr(OPPLUS, q->memoffset, ICON(typesize[q->vtype]));
 125:     }
 126: else
 127:     q = mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , 0.0);
 128: return(q);
 129: }
 130: 
 131: struct addrblock *putconst(p)
 132: register struct constblock *p;
 133: {
 134: register struct addrblock *q;
 135: struct literal *litp, *lastlit;
 136: int i, k, type;
 137: int litflavor;
 138: 
 139: if( ! ISCONST(p) )
 140:     fatal1("putconst: bad tag %d", p->tag);
 141: 
 142: q = ALLOC(addrblock);
 143: q->tag = TADDR;
 144: type = p->vtype;
 145: q->vtype = ( type==TYADDR ? TYINT : type );
 146: q->vleng = cpexpr(p->vleng);
 147: q->vstg = STGCONST;
 148: q->memno = newlabel();
 149: q->memoffset = ICON(0);
 150: 
 151: /* check for value in literal pool, and update pool if necessary */
 152: 
 153: switch(type = p->vtype)
 154:     {
 155:     case TYCHAR:
 156:         if(p->vleng->const.ci > XL)
 157:             break;  /* too long for literal table */
 158:         litflavor = 1;
 159:         goto loop;
 160: 
 161:     case TYREAL:
 162:     case TYDREAL:
 163:         litflavor = 2;
 164:         goto loop;
 165: 
 166:     case TYLOGICAL:
 167:         type = tylogical;
 168:     case TYSHORT:
 169:     case TYLONG:
 170:         litflavor = 3;
 171: 
 172:     loop:
 173:         lastlit = litpool + nliterals;
 174:         for(litp = litpool ; litp<lastlit ; ++litp)
 175:             if(type == litp->littype) switch(litflavor)
 176:                 {
 177:             case 1:
 178:                 if(p->vleng->const.ci != litp->litval.litcval.litclen)
 179:                     break;
 180:                 if(! eqn( (int) p->vleng->const.ci, p->const.ccp,
 181:                     litp->litval.litcval.litcstr) )
 182:                         break;
 183: 
 184:             ret:
 185:                 q->memno = litp->litnum;
 186:                 frexpr(p);
 187:                 return(q);
 188: 
 189:             case 2:
 190:                 if(p->const.cd[0] == litp->litval.litdval)
 191:                     goto ret;
 192:                 break;
 193: 
 194:             case 3:
 195:                 if(p->const.ci == litp->litval.litival)
 196:                     goto ret;
 197:                 break;
 198:                 }
 199:         if(nliterals < MAXLITERALS)
 200:             {
 201:             ++nliterals;
 202:             litp->littype = type;
 203:             litp->litnum = q->memno;
 204:             switch(litflavor)
 205:                 {
 206:                 case 1:
 207:                     litp->litval.litcval.litclen = p->vleng->const.ci;
 208:                     cpn( (int) litp->litval.litcval.litclen,
 209:                         p->const.ccp,
 210:                         litp->litval.litcval.litcstr);
 211:                     break;
 212: 
 213:                 case 2:
 214:                     litp->litval.litdval = p->const.cd[0];
 215:                     break;
 216: 
 217:                 case 3:
 218:                     litp->litval.litival = p->const.ci;
 219:                     break;
 220:                 }
 221:             }
 222:     default:
 223:         break;
 224:     }
 225: 
 226: preven(typealign[ type==TYCHAR ? TYLONG : type ]);
 227: prlabel(asmfile, q->memno);
 228: 
 229: k = 1;
 230: switch(type)
 231:     {
 232:     case TYLOGICAL:
 233:     case TYSHORT:
 234:     case TYLONG:
 235:         prconi(asmfile, type, p->const.ci);
 236:         break;
 237: 
 238:     case TYCOMPLEX:
 239:         k = 2;
 240:     case TYREAL:
 241:         type = TYREAL;
 242:         goto flpt;
 243: 
 244:     case TYDCOMPLEX:
 245:         k = 2;
 246:     case TYDREAL:
 247:         type = TYDREAL;
 248: 
 249:     flpt:
 250:         for(i = 0 ; i < k ; ++i)
 251:             prconr(asmfile, type, p->const.cd[i]);
 252:         break;
 253: 
 254:     case TYCHAR:
 255:         putstr(asmfile, p->const.ccp, p->vleng->const.ci);
 256:         break;
 257: 
 258:     case TYADDR:
 259:         prcona(asmfile, p->const.ci);
 260:         break;
 261: 
 262:     default:
 263:         fatal1("putconst: bad type %d", p->vtype);
 264:     }
 265: 
 266: frexpr(p);
 267: return( q );
 268: }
 269: 
 270: /*
 271:  * put out a character string constant.  begin every one on
 272:  * a long integer boundary, and pad with nulls
 273:  */
 274: putstr(fp, s, n)
 275: FILEP fp;
 276: char *s;
 277: ftnint n;
 278: {
 279: int b[SZSHORT];
 280: int i;
 281: 
 282: i = 0;
 283: while(--n >= 0)
 284:     {
 285:     b[i++] = *s++;
 286:     if(i == SZSHORT)
 287:         {
 288:         prchars(fp, b);
 289:         i = 0;
 290:         }
 291:     }
 292: 
 293: while(i < SZSHORT)
 294:     b[i++] = '\0';
 295: prchars(fp, b);
 296: }

Defined functions

Defined variables