![[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 [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1|
Return to put.c CVS log | Up to [CSRG BSD Unix] / 42BSD / usr.bin / f77 / src / f77pass1 |
1.1 root 1: /*
2: * INTERMEDIATE CODE GENERATION PROCEDURES COMMON TO BOTH
3: * JOHNSON (PORTABLE) AND RITCHIE FAMILIES OF SECOND PASSES
4: */
5:
6: #include "defs.h"
7:
8: #if FAMILY == PCC
9: # include "pccdefs.h"
10: #else
11: # include "dmrdefs.h"
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, P2INDIRECT,
37: P2BITOR, P2BITAND, P2BITXOR, P2BITNOT, P2RSHIFT, P2BAD
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: typesize[TYLOGICAL] = typesize[tylogical];
56: typealign[TYLOGICAL] = typealign[tylogical];
57: }
58:
59:
60: putex1(p)
61: expptr p;
62: {
63: putx( fixtype(p) );
64:
65: if (!optimflag)
66: {
67: templist = hookup(templist, holdtemps);
68: holdtemps = NULL;
69: }
70: }
71:
72:
73:
74:
75:
76: putassign(lp, rp)
77: expptr lp, rp;
78: {
79: putx( fixexpr( mkexpr(OPASSIGN, lp, rp) ));
80: }
81:
82:
83:
84:
85: puteq(lp, rp)
86: expptr lp, rp;
87: {
88: putexpr( mkexpr(OPASSIGN, lp, rp) );
89: }
90:
91:
92:
93:
94: /* put code for a *= b */
95:
96: putsteq(a, b)
97: expptr a, b;
98: {
99: putx( fixexpr( mkexpr(OPSTAREQ, cpexpr(a), cpexpr(b)) ));
100: }
101:
102:
103:
104:
105:
106: Addrp realpart(p)
107: register Addrp p;
108: {
109: register Addrp q;
110:
111: q = (Addrp) cpexpr(p);
112: if( ISCOMPLEX(p->vtype) )
113: q->vtype += (TYREAL-TYCOMPLEX);
114: return(q);
115: }
116:
117:
118:
119:
120: expptr imagpart(p)
121: register expptr p;
122: {
123: register Addrp q;
124: expptr mkrealcon();
125:
126: if (ISCONST(p))
127: {
128: if (ISCOMPLEX(p->constblock.vtype))
129: return(mkrealcon(p->constblock.vtype == TYCOMPLEX ?
130: TYREAL : TYDREAL,
131: p->constblock.const.cd[1]));
132: else if (p->constblock.vtype == TYDREAL)
133: return(mkrealcon(TYDREAL, 0.0));
134: else
135: return(mkrealcon(TYREAL, 0.0));
136: }
137: else if (p->tag == TADDR)
138: {
139: if( ISCOMPLEX(p->addrblock.vtype) )
140: {
141: q = (Addrp) cpexpr(p);
142: q->vtype += (TYREAL-TYCOMPLEX);
143: q->memoffset = mkexpr(OPPLUS, q->memoffset,
144: ICON(typesize[q->vtype]));
145: return( (expptr) q );
146: }
147: else
148: return( mkrealcon( ISINT(p->addrblock.vtype) ?
149: TYDREAL : p->addrblock.vtype , 0.0));
150: }
151: else
152: badtag("imagpart", p->tag);
153: }
154:
155:
156:
157:
158: ncat(p)
159: register expptr p;
160: {
161: if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
162: return( ncat(p->exprblock.leftp) + ncat(p->exprblock.rightp) );
163: else return(1);
164: }
165:
166:
167:
168:
169: ftnint lencat(p)
170: register expptr p;
171: {
172: if(p->tag==TEXPR && p->exprblock.opcode==OPCONCAT)
173: return( lencat(p->exprblock.leftp) + lencat(p->exprblock.rightp) );
174: else if( p->headblock.vleng!=NULL && ISICON(p->headblock.vleng) )
175: return(p->headblock.vleng->constblock.const.ci);
176: else if((p->tag==TADDR || p->tag==TTEMP) && p->addrblock.varleng!=0)
177: return(p->addrblock.varleng);
178: else
179: {
180: err("impossible element in concatenation");
181: return(0);
182: }
183: }
184:
185: Addrp putconst(p)
186: register Constp p;
187: {
188: register Addrp q;
189: struct Literal *litp, *lastlit;
190: int i, k, type;
191: int litflavor;
192:
193: if( p->tag != TCONST )
194: badtag("putconst", p->tag);
195:
196: q = ALLOC(Addrblock);
197: q->tag = TADDR;
198: type = p->vtype;
199: q->vtype = ( type==TYADDR ? TYINT : type );
200: q->vleng = (expptr) cpexpr(p->vleng);
201: q->vstg = STGCONST;
202: q->memno = newlabel();
203: q->memoffset = ICON(0);
204:
205: /* check for value in literal pool, and update pool if necessary */
206:
207: switch(type = p->vtype)
208: {
209: case TYCHAR:
210: if(p->vleng->constblock.const.ci > XL)
211: break; /* too long for literal table */
212: litflavor = 1;
213: goto loop;
214:
215: case TYREAL:
216: case TYDREAL:
217: litflavor = 2;
218: goto loop;
219:
220: case TYLOGICAL:
221: type = tylogical;
222: case TYSHORT:
223: case TYLONG:
224: litflavor = 3;
225:
226: loop:
227: lastlit = litpool + nliterals;
228: for(litp = litpool ; litp<lastlit ; ++litp)
229: if(type == litp->littype) switch(litflavor)
230: {
231: case 1:
232: if(p->vleng->constblock.const.ci != litp->litval.litcval.litclen)
233: break;
234: if(! eqn( (int) p->vleng->constblock.const.ci, p->const.ccp,
235: litp->litval.litcval.litcstr) )
236: break;
237:
238: ret:
239: q->memno = litp->litnum;
240: frexpr(p);
241: return(q);
242:
243: case 2:
244: if(p->const.cd[0] == litp->litval.litdval)
245: goto ret;
246: break;
247:
248: case 3:
249: if(p->const.ci == litp->litval.litival)
250: goto ret;
251: break;
252: }
253: if(nliterals < MAXLITERALS)
254: {
255: ++nliterals;
256: litp->littype = type;
257: litp->litnum = q->memno;
258: switch(litflavor)
259: {
260: case 1:
261: litp->litval.litcval.litclen =
262: p->vleng->constblock.const.ci;
263: cpn( (int) litp->litval.litcval.litclen,
264: p->const.ccp,
265: litp->litval.litcval.litcstr);
266: break;
267:
268: case 2:
269: litp->litval.litdval = p->const.cd[0];
270: break;
271:
272: case 3:
273: litp->litval.litival = p->const.ci;
274: break;
275: }
276: }
277: default:
278: break;
279: }
280:
281: preven(typealign[ type==TYCHAR ? TYLONG : type ]);
282: prlabel(asmfile, q->memno);
283:
284: k = 1;
285: switch(type)
286: {
287: case TYLOGICAL:
288: case TYSHORT:
289: case TYLONG:
290: prconi(asmfile, type, p->const.ci);
291: break;
292:
293: case TYCOMPLEX:
294: k = 2;
295: case TYREAL:
296: type = TYREAL;
297: goto flpt;
298:
299: case TYDCOMPLEX:
300: k = 2;
301: case TYDREAL:
302: type = TYDREAL;
303:
304: flpt:
305: for(i = 0 ; i < k ; ++i)
306: prconr(asmfile, type, p->const.cd[i]);
307: break;
308:
309: case TYCHAR:
310: putstr(asmfile, p->const.ccp,
311: (int) (p->vleng->constblock.const.ci) );
312: break;
313:
314: case TYADDR:
315: prcona(asmfile, p->const.ci);
316: break;
317:
318: default:
319: badtype("putconst", p->vtype);
320: }
321:
322: frexpr(p);
323: return( q );
324: }
325:
326: /*
327: * put out a character string constant. begin every one on
328: * a long integer boundary, and pad with nulls
329: */
330: putstr(fp, s, n)
331: FILEP fp;
332: char *s;
333: int n;
334: {
335: int b[SZSHORT];
336: int i;
337:
338: i = 0;
339: while(--n >= 0)
340: {
341: b[i++] = *s++;
342: if(i == SZSHORT)
343: {
344: prchars(fp, b);
345: i = 0;
346: }
347: }
348:
349: while(i < SZSHORT)
350: b[i++] = '\0';
351: prchars(fp, b);
352: }
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.