1 /* Id: put.c,v 1.17 2008/05/11 15:28:03 ragge Exp */
2 /* $NetBSD: put.c,v 1.1.1.2 2010/06/03 18:57:51 plunky Exp $ */
3 /*
4 * Copyright(C) Caldera International Inc. 2001-2002. All rights reserved.
5 *
6 * Redistribution and use in source and binary forms, with or without
7 * modification, are permitted provided that the following conditions
8 * are met:
9 *
10 * Redistributions of source code and documentation must retain the above
11 * copyright notice, this list of conditions and the following disclaimer.
12 * Redistributions in binary form must reproduce the above copyright
13 * notice, this list of conditions and the following disclaimer in the
14 * documentation and/or other materials provided with the distribution.
15 * All advertising materials mentioning features or use of this software
16 * must display the following acknowledgement:
17 * This product includes software developed or owned by Caldera
18 * International, Inc.
19 * Neither the name of Caldera International, Inc. nor the names of other
20 * contributors may be used to endorse or promote products derived from
21 * this software without specific prior written permission.
22 *
23 * USE OF THE SOFTWARE PROVIDED FOR UNDER THIS LICENSE BY CALDERA
24 * INTERNATIONAL, INC. AND CONTRIBUTORS ``AS IS'' AND ANY EXPRESS OR
25 * IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
26 * WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
27 * DISCLAIMED. IN NO EVENT SHALL CALDERA INTERNATIONAL, INC. BE LIABLE
28 * FOR ANY DIRECT, INDIRECT INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
29 * DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS
30 * OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)
31 * HOWEVER CAUSED AND ON ANY THEORY OFLIABILITY, WHETHER IN CONTRACT,
32 * STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING
33 * IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
34 * POSSIBILITY OF SUCH DAMAGE.
35 */
36 /*
37 * INTERMEDIATE CODE GENERATION PROCEDURES COMMON TO BOTH
38 * JOHNSON AND RITCHIE FAMILIES OF SECOND PASSES
39 */
40
41 #include "defines.h"
42 #include "defs.h"
43
44 #include "scjdefs.h"
45
46 char *ops [ ] =
47 {
48 "??", "+", "-", "*", "/", "**", "-",
49 "OR", "AND", "EQV", "NEQV", "NOT",
50 "CONCAT",
51 "<", "==", ">", "<=", "!=", ">=",
52 " of ", " ofC ", " = ", " += ", " *= ", " CONV ", " << ", " % ",
53 " , ", " ? ", " : "
54 " abs ", " min ", " max ", " addr ", " indirect ",
55 " bitor ", " bitand ", " bitxor ", " bitnot ", " >> ",
56 };
57
58 /*
59 * The index position here matches tho OPx numbers in defines.h.
60 * Do not change!
61 */
62 int ops2 [ ] =
63 {
64 P2BAD, P2PLUS, P2MINUS, P2STAR, P2SLASH, P2BAD, P2NEG,
65 P2BAD, P2BAD, P2EQ, P2NE, P2BAD,
66 P2BAD,
67 P2LT, P2EQ, P2GT, P2LE, P2NE, P2GE,
68 P2CALL, P2CALL, P2ASSIGN, P2BAD, P2BAD, P2CONV, P2LSHIFT, P2MOD,
69 P2BAD, P2BAD, P2BAD,
70 P2BAD, P2BAD, P2BAD, P2BAD, P2BAD,
71 P2BITOR, P2BITAND, P2BITXOR, P2BITNOT, P2RSHIFT
72 };
73
74
75 int types2 [ ] =
76 {
77 P2BAD, INT|PTR, SHORT, LONG, FLOAT, DOUBLE,
78 FLOAT, DOUBLE, LONG, CHAR, INT, P2BAD
79 };
80
81 void
setlog()82 setlog()
83 {
84 types2[TYLOGICAL] = types2[tylogical];
85 }
86
87 NODE *
putex1(bigptr q)88 putex1(bigptr q)
89 {
90 NODE *p;
91 q = fixtype(q);
92 p = putx(q);
93 templist = hookup(templist, holdtemps);
94 holdtemps = NULL;
95 return p;
96 }
97
98 /*
99 * Print out an assignment.
100 */
101 void
puteq(bigptr lp,bigptr rp)102 puteq(bigptr lp, bigptr rp)
103 {
104 putexpr(mkexpr(OPASSIGN, lp, rp));
105 }
106
107 /*
108 * Return a copied node of the real part of an expression.
109 */
110 struct bigblock *
realpart(struct bigblock * p)111 realpart(struct bigblock *p)
112 {
113 struct bigblock *q;
114
115 q = cpexpr(p);
116 if( ISCOMPLEX(p->vtype) )
117 q->vtype += (TYREAL-TYCOMPLEX);
118 return(q);
119 }
120
121 /*
122 * Return a copied node of the imaginary part of an expression.
123 */
124 struct bigblock *
imagpart(struct bigblock * p)125 imagpart(struct bigblock *p)
126 {
127 struct bigblock *q;
128
129 if( ISCOMPLEX(p->vtype) ) {
130 q = cpexpr(p);
131 q->vtype += (TYREAL-TYCOMPLEX);
132 q->b_addr.memoffset = mkexpr(OPPLUS, q->b_addr.memoffset,
133 MKICON(typesize[q->vtype]));
134 } else
135 q = mkrealcon( ISINT(p->vtype) ? TYDREAL : p->vtype , 0.0);
136 return(q);
137 }
138
139 struct bigblock *
putconst(struct bigblock * p)140 putconst(struct bigblock *p)
141 {
142 struct bigblock *q;
143 struct literal *litp, *lastlit;
144 int i, k, type;
145 int litflavor;
146
147 if( ! ISCONST(p) )
148 fatal1("putconst: bad tag %d", p->tag);
149
150 q = BALLO();
151 q->tag = TADDR;
152 type = p->vtype;
153 q->vtype = ( type==TYADDR ? TYINT : type );
154 q->vleng = cpexpr(p->vleng);
155 q->vstg = STGCONST;
156 q->b_addr.memno = newlabel();
157 q->b_addr.memoffset = MKICON(0);
158
159 /* check for value in literal pool, and update pool if necessary */
160
161 switch(type = p->vtype) {
162 case TYCHAR:
163 if(p->vleng->b_const.fconst.ci > XL)
164 break; /* too long for literal table */
165 litflavor = 1;
166 goto loop;
167
168 case TYREAL:
169 case TYDREAL:
170 litflavor = 2;
171 goto loop;
172
173 case TYLOGICAL:
174 type = tylogical;
175 case TYSHORT:
176 case TYLONG:
177 litflavor = 3;
178
179 loop:
180 lastlit = litpool + nliterals;
181 for(litp = litpool ; litp<lastlit ; ++litp)
182 if(type == litp->littype)
183 switch(litflavor) {
184 case 1:
185 if(p->vleng->b_const.fconst.ci !=
186 litp->litval.litcval.litclen)
187 break;
188 if(!eqn((int)p->vleng->b_const.fconst.ci,
189 p->b_const.fconst.ccp,
190 litp->litval.litcval.litcstr) )
191 break;
192 ret:
193 q->b_addr.memno = litp->litnum;
194 frexpr(p);
195 return(q);
196
197 case 2:
198 if(p->b_const.fconst.cd[0] ==
199 litp->litval.litdval)
200 goto ret;
201 break;
202
203 case 3:
204 if(p->b_const.fconst.ci == litp->litval.litival)
205 goto ret;
206 break;
207 }
208 if(nliterals < MAXLITERALS) {
209 ++nliterals;
210 litp->littype = type;
211 litp->litnum = q->b_addr.memno;
212 switch(litflavor) {
213 case 1:
214 litp->litval.litcval.litclen =
215 p->vleng->b_const.fconst.ci;
216 cpn( (int) litp->litval.litcval.litclen,
217 p->b_const.fconst.ccp,
218 litp->litval.litcval.litcstr);
219 break;
220
221 case 2:
222 litp->litval.litdval = p->b_const.fconst.cd[0];
223 break;
224
225 case 3:
226 litp->litval.litival = p->b_const.fconst.ci;
227 break;
228 }
229 }
230 default:
231 break;
232 }
233
234 preven(typealign[ type==TYCHAR ? TYLONG : type ]);
235 prlabel(q->b_addr.memno);
236
237 k = 1;
238 switch(type) {
239 case TYLOGICAL:
240 case TYSHORT:
241 case TYLONG:
242 prconi(stdout, type, p->b_const.fconst.ci);
243 break;
244
245 case TYCOMPLEX:
246 k = 2;
247 case TYREAL:
248 type = TYREAL;
249 goto flpt;
250
251 case TYDCOMPLEX:
252 k = 2;
253 case TYDREAL:
254 type = TYDREAL;
255
256 flpt:
257 for(i = 0 ; i < k ; ++i)
258 prconr(stdout, type, p->b_const.fconst.cd[i]);
259 break;
260
261 case TYCHAR:
262 putstr(p->b_const.fconst.ccp,
263 p->vleng->b_const.fconst.ci);
264 break;
265
266 case TYADDR:
267 prcona(p->b_const.fconst.ci);
268 break;
269
270 default:
271 fatal1("putconst: bad type %d", p->vtype);
272 }
273
274 frexpr(p);
275 return( q );
276 }
277
278 /*
279 * put out a character string constant. begin every one on
280 * a long integer boundary, and pad with nulls
281 */
282 void
putstr(char * s,ftnint n)283 putstr(char *s, ftnint n)
284 {
285 int b[FSZSHORT];
286 int i;
287
288 i = 0;
289 while(--n >= 0) {
290 b[i++] = *s++;
291 if(i == FSZSHORT) {
292 prchars(b);
293 i = 0;
294 }
295 }
296
297 while(i < FSZSHORT)
298 b[i++] = '\0';
299 prchars(b);
300 }
301