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