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