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