# 2.11BSD#431 - /usr/src/usr.bin/f77/put.c

##### Functions

    imagpart          X
    putassign         X
    putconst          X
    puteq             X
    putex1            X
    putsteq           X
    putstr            X
    realpart          X
    setlog            X

##### Variables

    ops2              X
    types2            X

       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

imagpart defined in line 115; used 28 times

- in /usr/src/usr.bin/f77/putdmr.c line 572(2), 663(2), 671-679(9), 690(2), 697-705(7), 717(2), 724-729(2), 761(2)

putassign defined in line 71; used 30 times

- in /usr/src/usr.bin/f77/putdmr.c line 504, 518, 551, 568-572(2), 619, 629, 662-663(2), 669-679(5), 689-690(2), 696-703(4), 716-722(3), 729, 943-944(2), 1117, 1171-1180(3)

putconst defined in line 132; used 10 times

- in /usr/src/usr.bin/f77/defs line 441
- in /usr/src/usr.bin/f77/expr.c line 352, 630, 2124
- in /usr/src/usr.bin/f77/io.c line 514
- in /usr/src/usr.bin/f77/putdmr.c line 233, 611, 775-780(2), 1066

puteq defined in line 80; used 13 times

- in /usr/src/usr.bin/f77/exec.c line 153, 361, 390-397(3), 415, 449, 480
- in /usr/src/usr.bin/f77/io.c line 476, 783
- in /usr/src/usr.bin/f77/pdp11.c line 390-398(3)

putex1 defined in line 59; used 2 times

- in /usr/src/usr.bin/f77/putdmr.c line 89, 140

putsteq defined in line 91; used 3 times

- in /usr/src/usr.bin/f77/putdmr.c line 509, 523-527(2)

putstr defined in line 275; used 2 times

- in line 256
- in /usr/src/usr.bin/f77/io.c line 210

realpart defined in line 101; used 25 times

- in /usr/src/usr.bin/f77/putdmr.c line 192, 304, 568(2), 662(2), 669(3), 689(2), 696-705(7), 716(2), 722-726(3), 760(2)

setlog defined in line 53; used 1 times

- in /usr/src/usr.bin/f77/init.c line 223

#### Defined variables

ops2 defined in line 29; used 2 times

- in /usr/src/usr.bin/f77/putdmr.c line 463, 871

types2 defined in line 42; used 7 times

- in line 55(2)
- in /usr/src/usr.bin/f77/putdmr.c line 434, 468, 957, 1046, 1198

Last modified: 1987-02-17 Generated: 2016-12-26 | Generated by src2html V0.67 page hit count: 709 |