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