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