1 /*-
2 * Copyright (c) 1980, 1993
3 * The Regents of the University of California. All rights reserved.
4 *
5 * %sccs.include.redist.c%
6 */
7
8 #ifndef lint
9 static char sccsid[] = "@(#)conv.c 8.1 (Berkeley) 06/06/93";
10 #endif /* not lint */
11
12 #include "whoami.h"
13 #ifdef PI
14 #include "0.h"
15 #include "opcode.h"
16 #ifdef PC
17 # include <pcc.h>
18 #endif PC
19 #include "tree_ty.h"
20
21 #ifndef PC
22 #ifndef PI0
23 /*
24 * Convert a p1 into a p2.
25 * Mostly used for different
26 * length integers and "to real" conversions.
27 */
28 convert(p1, p2)
29 struct nl *p1, *p2;
30 {
31 if (p1 == NLNIL || p2 == NLNIL)
32 return;
33 switch (width(p1) - width(p2)) {
34 case -7:
35 case -6:
36 (void) put(1, O_STOD);
37 return;
38 case -4:
39 (void) put(1, O_ITOD);
40 return;
41 case -3:
42 case -2:
43 (void) put(1, O_STOI);
44 return;
45 case -1:
46 case 0:
47 case 1:
48 return;
49 case 2:
50 case 3:
51 (void) put(1, O_ITOS);
52 return;
53 default:
54 panic("convert");
55 }
56 }
57 #endif
58 #endif PC
59
60 /*
61 * Compat tells whether
62 * p1 and p2 are compatible
63 * types for an assignment like
64 * context, i.e. value parameters,
65 * indicies for 'in', etc.
66 */
67 compat(p1, p2, t)
68 struct nl *p1, *p2;
69 struct tnode *t;
70 {
71 register c1, c2;
72
73 c1 = classify(p1);
74 if (c1 == NIL)
75 return (NIL);
76 c2 = classify(p2);
77 if (c2 == NIL)
78 return (NIL);
79 switch (c1) {
80 case TBOOL:
81 case TCHAR:
82 if (c1 == c2)
83 return (1);
84 break;
85 case TINT:
86 if (c2 == TINT)
87 return (1);
88 case TDOUBLE:
89 if (c2 == TDOUBLE)
90 return (1);
91 #ifndef PI0
92 if (c2 == TINT && divflg == FALSE && t != TR_NIL ) {
93 divchk= TRUE;
94 c1 = classify(rvalue(t, NLNIL , RREQ ));
95 divchk = FALSE;
96 if (c1 == TINT) {
97 error("Type clash: real is incompatible with integer");
98 cerror("This resulted because you used '/' which always returns real rather");
99 cerror("than 'div' which divides integers and returns integers");
100 divflg = TRUE;
101 return (NIL);
102 }
103 }
104 #endif
105 break;
106 case TSCAL:
107 if (c2 != TSCAL)
108 break;
109 if (scalar(p1) != scalar(p2)) {
110 derror("Type clash: non-identical scalar types");
111 return (NIL);
112 }
113 return (1);
114 case TSTR:
115 if (c2 != TSTR)
116 break;
117 if (width(p1) != width(p2)) {
118 derror("Type clash: unequal length strings");
119 return (NIL);
120 }
121 return (1);
122 case TNIL:
123 if (c2 != TPTR)
124 break;
125 return (1);
126 case TFILE:
127 if (c1 != c2)
128 break;
129 derror("Type clash: files not allowed in this context");
130 return (NIL);
131 default:
132 if (c1 != c2)
133 break;
134 if (p1 != p2) {
135 derror("Type clash: non-identical %s types", clnames[c1]);
136 return (NIL);
137 }
138 if (p1->nl_flags & NFILES) {
139 derror("Type clash: %ss with file components not allowed in this context", clnames[c1]);
140 return (NIL);
141 }
142 return (1);
143 }
144 derror("Type clash: %s is incompatible with %s", clnames[c1], clnames[c2]);
145 return (NIL);
146 }
147
148 #ifndef PI0
149 #ifndef PC
150 /*
151 * Rangechk generates code to
152 * check if the type p on top
153 * of the stack is in range for
154 * assignment to a variable
155 * of type q.
156 */
157 rangechk(p, q)
158 struct nl *p, *q;
159 {
160 register struct nl *rp;
161 #ifdef OBJ
162 register op;
163 int wq, wrp;
164 #endif
165
166 if (opt('t') == 0)
167 return;
168 rp = p;
169 if (rp == NIL)
170 return;
171 if (q == NIL)
172 return;
173 # ifdef OBJ
174 /*
175 * When op is 1 we are checking length
176 * 4 numbers against length 2 bounds,
177 * and adding it to the opcode forces
178 * generation of appropriate tests.
179 */
180 op = 0;
181 wq = width(q);
182 wrp = width(rp);
183 op = wq != wrp && (wq == 4 || wrp == 4);
184 if (rp->class == TYPE || rp->class == CRANGE)
185 rp = rp->type;
186 switch (rp->class) {
187 case RANGE:
188 if (rp->range[0] != 0) {
189 # ifndef DEBUG
190 if (wrp <= 2)
191 (void) put(3, O_RANG2+op, ( short ) rp->range[0],
192 ( short ) rp->range[1]);
193 else if (rp != nl+T4INT)
194 (void) put(3, O_RANG4+op, rp->range[0], rp->range[1] );
195 # else
196 if (!hp21mx) {
197 if (wrp <= 2)
198 (void) put(3, O_RANG2+op,( short ) rp->range[0],
199 ( short ) rp->range[1]);
200 else if (rp != nl+T4INT)
201 (void) put(3, O_RANG4+op,rp->range[0],
202 rp->range[1]);
203 } else
204 if (rp != nl+T2INT && rp != nl+T4INT)
205 (void) put(3, O_RANG2+op,( short ) rp->range[0],
206 ( short ) rp->range[1]);
207 # endif
208 break;
209 }
210 /*
211 * Range whose lower bounds are
212 * zero can be treated as scalars.
213 */
214 case SCAL:
215 if (wrp <= 2)
216 (void) put(2, O_RSNG2+op, ( short ) rp->range[1]);
217 else
218 (void) put( 2 , O_RSNG4+op, rp->range[1]);
219 break;
220 default:
221 panic("rangechk");
222 }
223 # endif OBJ
224 # ifdef PC
225 /*
226 * pc uses precheck() and postcheck().
227 */
228 panic("rangechk()");
229 # endif PC
230 }
231 #endif
232 #endif
233 #endif
234
235 #ifdef PC
236 /*
237 * if type p requires a range check,
238 * then put out the name of the checking function
239 * for the beginning of a function call which is completed by postcheck.
240 * (name1 is for a full check; name2 assumes a lower bound of zero)
241 */
242 precheck( p , name1 , name2 )
243 struct nl *p;
244 char *name1 , *name2;
245 {
246
247 if ( opt( 't' ) == 0 ) {
248 return;
249 }
250 if ( p == NIL ) {
251 return;
252 }
253 if ( p -> class == TYPE ) {
254 p = p -> type;
255 }
256 switch ( p -> class ) {
257 case CRANGE:
258 putleaf( PCC_ICON , 0 , 0 , PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR )
259 , name1);
260 break;
261 case RANGE:
262 if ( p != nl + T4INT ) {
263 putleaf( PCC_ICON , 0 , 0 ,
264 PCCM_ADDTYPE( PCCTM_FTN | PCCT_INT , PCCTM_PTR ),
265 p -> range[0] != 0 ? name1 : name2 );
266 }
267 break;
268 case SCAL:
269 /*
270 * how could a scalar ever be out of range?
271 */
272 break;
273 default:
274 panic( "precheck" );
275 break;
276 }
277 }
278
279 /*
280 * if type p requires a range check,
281 * then put out the rest of the arguments of to the checking function
282 * a call to which was started by precheck.
283 * the first argument is what is being rangechecked (put out by rvalue),
284 * the second argument is the lower bound of the range,
285 * the third argument is the upper bound of the range.
286 */
287 postcheck(need, have)
288 struct nl *need;
289 struct nl *have;
290 {
291 struct nl *p;
292
293 if ( opt( 't' ) == 0 ) {
294 return;
295 }
296 if ( need == NIL ) {
297 return;
298 }
299 if ( need -> class == TYPE ) {
300 need = need -> type;
301 }
302 switch ( need -> class ) {
303 case RANGE:
304 if ( need != nl + T4INT ) {
305 sconv(p2type(have), PCCT_INT);
306 if (need -> range[0] != 0 ) {
307 putleaf( PCC_ICON , (int) need -> range[0] , 0 , PCCT_INT ,
308 (char *) 0 );
309 putop( PCC_CM , PCCT_INT );
310 }
311 putleaf( PCC_ICON , (int) need -> range[1] , 0 , PCCT_INT ,
312 (char *) 0 );
313 putop( PCC_CM , PCCT_INT );
314 putop( PCC_CALL , PCCT_INT );
315 sconv(PCCT_INT, p2type(have));
316 }
317 break;
318 case CRANGE:
319 sconv(p2type(have), PCCT_INT);
320 p = need->nptr[0];
321 putRV(p->symbol, (p->nl_block & 037), p->value[0],
322 p->extra_flags, p2type( p ) );
323 putop( PCC_CM , PCCT_INT );
324 p = need->nptr[1];
325 putRV(p->symbol, (p->nl_block & 037), p->value[0],
326 p->extra_flags, p2type( p ) );
327 putop( PCC_CM , PCCT_INT );
328 putop( PCC_CALL , PCCT_INT );
329 sconv(PCCT_INT, p2type(have));
330 break;
331 case SCAL:
332 break;
333 default:
334 panic( "postcheck" );
335 break;
336 }
337 }
338 #endif PC
339
340 #ifdef DEBUG
conv(dub)341 conv(dub)
342 int *dub;
343 {
344 int newfp[2];
345 double *dp = ((double *) dub);
346 long *lp = ((long *) dub);
347 register int exp;
348 long mant;
349
350 newfp[0] = dub[0] & 0100000;
351 newfp[1] = 0;
352 if (*dp == 0.0)
353 goto ret;
354 exp = ((dub[0] >> 7) & 0377) - 0200;
355 if (exp < 0) {
356 newfp[1] = 1;
357 exp = -exp;
358 }
359 if (exp > 63)
360 exp = 63;
361 dub[0] &= ~0177600;
362 dub[0] |= 0200;
363 mant = *lp;
364 mant <<= 8;
365 if (newfp[0])
366 mant = -mant;
367 newfp[0] |= (mant >> 17) & 077777;
368 newfp[1] |= (((int) (mant >> 1)) & 0177400) | (exp << 1);
369 ret:
370 dub[0] = newfp[0];
371 dub[1] = newfp[1];
372 }
373 #endif
374