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