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

Defined functions

Defined variables